From 8af2ec4dcef3d3bdfdfd0a5581a13b47abb7d71a Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 13 Nov 2024 15:43:24 +0100 Subject: [PATCH] test: Test all profiles (#2618) * test: Test all profiles Format every test files for every profiles and promote the output to: test/passing/refs./ The generated dune rules are written in a way that they can be included in the profile directories. The main reason for this change is to increase the coverage for the default profile, which was barely tested. This also avoids tests without a ref file, which are frustrating to work with. The '.ref' extension for output files is not dropped to avoid confusing output files for input files. Duplicate test cases are removed (eg. between source.ml and js_source.ml). THe ocp-indent output is removed as it was not used anymore. 'verbose1.ml' test is removed because it doesn't work well with the `--name` option. The '.extra-deps' extension is also removed as it was not used. The size of the dune file is also slightly reduced because the (package) stanza could be removed. --- test/passing/dune | 20 - test/passing/dune.inc | 5711 --------- test/passing/gen/dune | 19 + test/passing/gen/dune.inc | 4634 +++++++ test/passing/gen/gen.ml | 79 +- test/passing/refs.default/.ocamlformat | 1 + test/passing/refs.default/align_infix.ml.ref | 5 + test/passing/refs.default/alignment.ml.ref | 19 + test/passing/refs.default/apply.ml.ref | 81 + .../passing/refs.default/apply_functor.ml.ref | 8 + test/passing/refs.default/args_grouped.ml.ref | 90 + test/passing/refs.default/array.ml.ref | 43 + .../assignment_operator-op_begin_line.ml.err | 1 + .../assignment_operator-op_begin_line.ml.ref | 60 + .../refs.default/assignment_operator.ml.err | 1 + .../refs.default/assignment_operator.ml.ref | 62 + .../attribute_and_expression.ml.ref | 7 + test/passing/refs.default/attributes.ml.err | 3 + test/passing/refs.default/attributes.ml.ref | 411 + .../attributes.mli.ref | 0 test/passing/refs.default/binders.ml.ref | 15 + .../refs.default/break_before_in-auto.ml.err | 1 + .../break_before_in-auto.ml.ref | 34 +- .../refs.default/break_before_in.ml.ref | 66 + .../refs.default/break_cases-align.ml.err | 1 + .../refs.default/break_cases-align.ml.ref | 326 + .../refs.default/break_cases-all.ml.err | 1 + .../refs.default/break_cases-all.ml.ref | 326 + ...reak_cases-closing_on_separate_line.ml.err | 1 + ...reak_cases-closing_on_separate_line.ml.ref | 344 + ...ng_on_separate_line_fit_or_vertical.ml.err | 1 + ...ng_on_separate_line_fit_or_vertical.ml.ref | 300 + ...te_line_leading_nested_match_parens.ml.err | 1 + ...te_line_leading_nested_match_parens.ml.ref | 341 + .../break_cases-cosl_lnmp_cmei.ml.err | 1 + .../break_cases-cosl_lnmp_cmei.ml.ref | 341 + .../break_cases-fit_or_vertical.ml.err | 1 + .../break_cases-fit_or_vertical.ml.ref | 279 + .../refs.default/break_cases-nested.ml.err | 1 + .../refs.default/break_cases-nested.ml.ref | 267 + .../break_cases-normal_indent.ml.err | 1 + .../break_cases-normal_indent.ml.ref | 326 + .../refs.default/break_cases-toplevel.ml.err | 1 + .../refs.default/break_cases-toplevel.ml.ref | 285 + .../refs.default/break_cases-vertical.ml.err | 1 + .../refs.default/break_cases-vertical.ml.ref | 366 + test/passing/refs.default/break_cases.ml.err | 1 + test/passing/refs.default/break_cases.ml.ref | 236 + .../break_collection_expressions-wrap.ml.ref | 78 + .../break_collection_expressions.ml.ref | 288 + .../refs.default/break_colon-before.ml.ref | 92 + test/passing/refs.default/break_colon.ml.ref | 92 + .../break_fun_decl-fit_or_vertical.ml.ref | 150 + .../refs.default/break_fun_decl-smart.ml.ref | 143 + .../refs.default/break_fun_decl-wrap.ml.ref | 124 + .../refs.default/break_fun_decl.ml.ref | 124 + .../break_infix-fit-or-vertical.ml.err | 1 + .../break_infix-fit-or-vertical.ml.ref | 128 + .../refs.default/break_infix-wrap.ml.err | 1 + .../refs.default/break_infix-wrap.ml.ref | 85 + test/passing/refs.default/break_infix.ml.err | 1 + test/passing/refs.default/break_infix.ml.ref | 117 + test/passing/refs.default/break_record.ml.ref | 6 + .../break_separators-after.ml.ref | 434 + .../break_separators-after_docked.ml.ref | 434 + .../break_separators-before_docked.ml.ref | 434 + .../refs.default/break_separators.ml.ref | 434 + .../refs.default/break_sequence_before.ml.ref | 47 + .../break_string_literals-never.ml.err | 6 + .../break_string_literals-never.ml.ref | 50 + .../refs.default/break_string_literals.ml.ref | 85 + test/passing/refs.default/break_struct.ml.ref | 77 + .../refs.default/cases_exp_grouping.ml.ref | 93 + test/passing/refs.default/cinaps.ml.ref | 74 + test/passing/refs.default/class_expr.ml.err | 1 + test/passing/refs.default/class_expr.ml.ref | 19 + .../refs.default/class_sig-after.mli.ref | 37 + test/passing/refs.default/class_sig.mli.ref | 37 + test/passing/refs.default/class_type.ml.ref | 15 + .../refs.default/cmdline_override.ml.ref | 3 + .../refs.default/cmdline_override2.ml.ref | 3 + test/passing/refs.default/coerce.ml.ref | 24 + .../refs.default/comment_breaking.ml.ref | 8 + .../comment_header.ml.ref | 4 +- .../refs.default/comment_in_empty.ml.ref | 43 + .../refs.default/comment_in_modules.ml.ref | 32 + test/passing/refs.default/comment_last.ml.ref | 4 + .../refs.default/comment_sparse.ml.ref | 10 + .../refs.default/comments-no-wrap.ml.err | 3 + .../refs.default/comments-no-wrap.ml.ref | 434 + test/passing/refs.default/comments.ml.err | 3 + test/passing/refs.default/comments.ml.ref | 434 + test/passing/refs.default/comments.mli.ref | 7 + .../comments_args.ml.ref | 0 .../comments_around_disabled.ml.ref | 0 .../refs.default/comments_in_local_let.ml.ref | 11 + ...nts_in_record-break_separator-after.ml.err | 3 + ...nts_in_record-break_separator-after.ml.ref | 134 + ...ts_in_record-break_separator-before.ml.err | 3 + ...ts_in_record-break_separator-before.ml.ref | 134 + .../refs.default/comments_in_record.ml.err | 3 + .../refs.default/comments_in_record.ml.ref | 134 + test/passing/refs.default/crlf_to_crlf.ml.ref | 41 + test/passing/refs.default/crlf_to_lf.ml.ref | 41 + test/passing/refs.default/custom_list.ml.ref | 3 + .../directives.mlt.ref | 0 test/passing/refs.default/disable_attr.ml.ref | 4 + .../refs.default/disable_class_type.ml.ref | 8 + .../refs.default/disable_conf_attrs.ml.err | 40 + .../refs.default/disable_conf_attrs.ml.ref | 8 + .../refs.default/disable_local_let.ml.ref | 35 + test/passing/refs.default/disabled.ml.ref | 2 + .../passing/refs.default/disabled_attr.ml.ref | 21 + test/passing/refs.default/disambiguate.ml.ref | 87 + .../refs.default/disambiguated_types.ml.ref | 3 + .../{tests => refs.default}/doc.mld.ref | 35 +- .../refs.default/doc_comments-after.ml.err | 4 + .../doc_comments-after.ml.ref | 24 +- .../doc_comments-before-except-val.ml.err | 4 + .../doc_comments-before-except-val.ml.ref | 24 +- .../refs.default/doc_comments-before.ml.err | 4 + .../doc_comments-before.ml.ref | 24 +- .../doc_comments-no-parse-docstrings.mli.err | 20 + .../doc_comments-no-parse-docstrings.mli.ref | 657 + .../refs.default/doc_comments-no-wrap.mli.err | 13 + .../doc_comments-no-wrap.mli.ref | 182 +- test/passing/refs.default/doc_comments.ml.err | 4 + .../doc_comments.ml.ref | 84 +- .../passing/refs.default/doc_comments.mli.err | 13 + .../doc_comments.mli.ref | 192 +- .../refs.default/doc_comments_padding.ml.ref | 13 + test/passing/refs.default/doc_repl.mld.ref | 89 + .../docstrings_toplevel_directives.mlt.ref | 11 + test/passing/refs.default/dune | 1 + test/passing/refs.default/dune-project | 1 + test/passing/refs.default/eliom_ext.eliom.ref | 47 + test/passing/refs.default/empty_ml.ml.ref | 3 + test/passing/refs.default/empty_mli.mli.ref | 3 + test/passing/refs.default/empty_mlt.mlt.ref | 3 + test/passing/refs.default/error1.ml.err | 3 + test/passing/refs.default/error2.ml.err | 5 + test/passing/refs.default/error3.ml.err | 11 + test/passing/refs.default/error4.ml.err | 9 + .../{tests => refs.default}/error4.ml.ref | 0 test/passing/refs.default/escaped_nl.ml.ref | 20 + test/passing/refs.default/exceptions.ml.ref | 67 + test/passing/refs.default/exceptions.mli.ref | 62 + .../refs.default/exp_grouping-parens.ml.ref | 351 + test/passing/refs.default/exp_grouping.ml.ref | 409 + test/passing/refs.default/exp_record.ml.ref | 9 + test/passing/refs.default/expect_test.ml.err | 3 + test/passing/refs.default/expect_test.ml.ref | 24 + .../refs.default/extensions-indent.ml.ref | 454 + .../refs.default/extensions-indent.mli.ref | 88 + test/passing/refs.default/extensions.ml.ref | 454 + test/passing/refs.default/extensions.mli.ref | 88 + .../extensions_exp_grouping.ml.ref | 36 +- .../refs.default/field-op_begin_line.ml.ref | 26 + test/passing/refs.default/field.ml.ref | 26 + .../refs.default/first_class_module.ml.ref | 117 + test/passing/refs.default/floating_doc.ml.ref | 11 + test/passing/refs.default/for_while.ml.ref | 50 + .../fun_decl-no-wrap-fun-args.ml.ref | 112 + test/passing/refs.default/fun_decl.ml.ref | 97 + .../fun_function.ml.ref | 19 +- .../function_indent-never.ml.ref | 15 +- .../function_indent.ml.ref | 15 +- test/passing/refs.default/functor.ml.err | 2 + test/passing/refs.default/functor.ml.ref | 91 + test/passing/refs.default/functor.mli.ref | 3 + test/passing/refs.default/funsig.ml.ref | 71 + test/passing/refs.default/gadt.ml.ref | 15 + test/passing/refs.default/generative.ml.ref | 9 + test/passing/refs.default/hash_bang.ml.ref | 3 + test/passing/refs.default/hash_types.ml.ref | 13 + test/passing/refs.default/holes.ml.ref | 11 + test/passing/refs.default/ifand.ml.ref | 2 + test/passing/refs.default/index_op.ml.ref | 146 + .../indicate_multiline_delimiters-cosl.ml.ref | 63 + ...indicate_multiline_delimiters-space.ml.ref | 56 + .../indicate_multiline_delimiters.ml.ref | 56 + .../refs.default/infix_arg_grouping.ml.err | 1 + .../refs.default/infix_arg_grouping.ml.ref | 145 + .../refs.default/infix_bind-break.ml.ref | 240 + .../infix_bind-fit_or_vertical-break.ml.ref | 246 + .../infix_bind-fit_or_vertical.ml.ref | 228 + test/passing/refs.default/infix_bind.ml.ref | 222 + .../refs.default/infix_precedence.ml.ref | 12 + test/passing/refs.default/injectivity.ml.ref | 76 + .../{tests => refs.default}/into_infix.ml.ref | 0 test/passing/refs.default/invalid.ml.ref | 7 + .../refs.default/invalid_docstring.ml.err | 6 + .../invalid_docstring.ml.ref | 0 .../invalid_docstrings.mli.ref | 4 +- test/passing/refs.default/issue114.ml.ref | 1 + test/passing/refs.default/issue1750.ml.err | 1 + test/passing/refs.default/issue1750.ml.ref | 112 + test/passing/refs.default/issue289.ml.err | 1 + test/passing/refs.default/issue289.ml.ref | 85 + test/passing/refs.default/issue48.ml.ref | 3 + test/passing/refs.default/issue51.ml.ref | 2 + test/passing/refs.default/issue57.ml.ref | 5 + test/passing/refs.default/issue60.ml.ref | 1 + test/passing/refs.default/issue77.ml.ref | 12 + test/passing/refs.default/issue85.ml.ref | 3 + test/passing/refs.default/issue89.ml.ref | 1 + test/passing/refs.default/ite-compact.ml.err | 3 + test/passing/refs.default/ite-compact.ml.ref | 176 + .../refs.default/ite-compact_closing.ml.ref | 191 + .../refs.default/ite-fit_or_vertical.ml.err | 3 + .../refs.default/ite-fit_or_vertical.ml.ref | 211 + .../ite-fit_or_vertical_closing.ml.ref | 221 + .../ite-fit_or_vertical_no_indicate.ml.err | 3 + .../ite-fit_or_vertical_no_indicate.ml.ref | 211 + test/passing/refs.default/ite-kr.ml.ref | 252 + .../refs.default/ite-kr_closing.ml.ref | 259 + test/passing/refs.default/ite-kw_first.ml.err | 3 + test/passing/refs.default/ite-kw_first.ml.ref | 205 + .../refs.default/ite-kw_first_closing.ml.ref | 220 + .../ite-kw_first_no_indicate.ml.err | 3 + .../ite-kw_first_no_indicate.ml.ref | 205 + .../refs.default/ite-no_indicate.ml.err | 3 + .../refs.default/ite-no_indicate.ml.ref | 176 + test/passing/refs.default/ite-vertical.ml.err | 3 + test/passing/refs.default/ite-vertical.ml.ref | 250 + test/passing/refs.default/ite.ml.err | 3 + test/passing/refs.default/ite.ml.ref | 176 + test/passing/refs.default/js_args.ml.ref | 127 + test/passing/refs.default/js_begin.ml.ref | 11 + test/passing/refs.default/js_bind.ml.ref | 21 + test/passing/refs.default/js_fun.ml.ref | 32 + .../{tests => refs.default}/js_map.ml.ref | 0 test/passing/refs.default/js_pattern.ml.ref | 16 + test/passing/refs.default/js_poly.ml.ref | 6 + test/passing/refs.default/js_record.ml.ref | 50 + test/passing/refs.default/js_sig.mli.ref | 22 + test/passing/refs.default/js_source.ml.err | 5 + test/passing/refs.default/js_source.ml.ref | 828 ++ test/passing/refs.default/js_syntax.ml.ref | 11 + test/passing/refs.default/js_to_do.ml.err | 1 + test/passing/refs.default/js_to_do.ml.ref | 63 + test/passing/refs.default/js_upon.ml.ref | 14 + .../passing/refs.default/kw_extentions.ml.ref | 57 + .../label_option_default_args.ml.ref | 105 + .../refs.default/labelled_args-414.ml.ref | 39 + .../passing/refs.default/labelled_args.ml.ref | 39 + test/passing/refs.default/lazy.ml.ref | 16 + .../let_binding-deindent-fun.ml.ref | 264 + .../refs.default/let_binding-in_indent.ml.ref | 264 + .../refs.default/let_binding-indent.ml.ref | 265 + test/passing/refs.default/let_binding.ml.ref | 264 + ...et_binding_spacing-double-semicolon.ml.ref | 17 + .../let_binding_spacing-sparse.ml.ref | 17 + .../refs.default/let_binding_spacing.ml.ref | 15 + .../passing/refs.default/let_in_constr.ml.ref | 4 + .../refs.default/let_module-sparse.ml.ref | 72 + test/passing/refs.default/let_module.ml.ref | 64 + test/passing/refs.default/let_punning.ml.ref | 14 + .../refs.default/line_directives.ml.err | 5 + .../refs.default/list-space_around.ml.ref | 83 + test/passing/refs.default/list.ml.ref | 83 + .../refs.default/list_and_comments.ml.ref | 1 + .../refs.default/list_normalized.ml.ref | 52 + test/passing/refs.default/loc_stack.ml.ref | 33 + .../refs.default/locally_abtract_types.ml.ref | 6 + test/passing/refs.default/margin_80.ml.err | 2 + test/passing/refs.default/margin_80.ml.ref | 23 + test/passing/refs.default/match.ml.ref | 72 + test/passing/refs.default/match2.ml.ref | 90 + .../match_indent-never.ml.ref | 0 .../match_indent.ml.ref | 0 test/passing/refs.default/max_indent.ml.ref | 100 + .../refs.default/mod_type_subst.ml.ref | 171 + test/passing/refs.default/module.ml.ref | 114 + .../refs.default/module_anonymous.ml.ref | 30 + .../refs.default/module_attributes.ml.ref | 45 + .../module_item_spacing-preserve.ml.ref | 129 + .../module_item_spacing-sparse.ml.ref | 150 + .../refs.default/module_item_spacing.ml.ref | 117 + .../refs.default/module_item_spacing.mli.ref | 103 + test/passing/refs.default/module_type.ml.err | 2 + test/passing/refs.default/module_type.ml.ref | 109 + test/passing/refs.default/module_type.mli.err | 1 + .../module_type.mli.ref | 0 .../refs.default/monadic_binding.ml.ref | 30 + .../refs.default/multi_index_op.ml.ref | 12 + .../refs.default/named_existentials.ml.ref | 22 + test/passing/refs.default/need_format.ml.err | 1 + test/passing/refs.default/new.ml.ref | 8 + test/passing/refs.default/object.ml.ref | 276 + test/passing/refs.default/object2.ml.ref | 27 + .../refs.default/object_expr-414.ml.ref | 23 + test/passing/refs.default/object_expr.ml.ref | 23 + test/passing/refs.default/object_type.ml.ref | 64 + test/passing/refs.default/obuild.ml.ref | 9 + ...ocp_indent_compat-break_colon_after.ml.ref | 94 + .../refs.default/ocp_indent_compat.ml.ref | 94 + .../refs.default/ocp_indent_options.ml.ref | 8 + .../open-closing-on-separate-line.ml.ref | 353 + test/passing/refs.default/open.ml.err | 1 + test/passing/refs.default/open.ml.ref | 342 + test/passing/refs.default/open_types.ml.ref | 2 + test/passing/refs.default/option.ml.err | 29 + test/passing/refs.default/option.ml.ref | 64 + test/passing/refs.default/override.ml.ref | 5 + .../refs.default/parens_tuple_patterns.ml.ref | 5 + .../polytypes.ml.ref} | 0 .../refs.default/pre_post_extensions.ml.ref | 15 + test/passing/refs.default/precedence.ml.ref | 3 + test/passing/refs.default/prefix_infix.ml.ref | 15 + test/passing/refs.default/profiles.ml.ref | 7 + test/passing/refs.default/profiles2.ml.ref | 5 + .../protected_object_types.ml.ref | 74 + test/passing/refs.default/qtest.ml.err | 1 + test/passing/refs.default/qtest.ml.ref | 59 + .../refs.default/quoted_strings.ml.ref | 37 + test/passing/refs.default/recmod.mli.ref | 19 + test/passing/refs.default/record-402.ml.err | 2 + test/passing/refs.default/record-402.ml.ref | 77 + test/passing/refs.default/record-loose.ml.err | 2 + .../record-loose.ml.ref} | 0 .../refs.default/record-tight_decl.ml.err | 2 + .../refs.default/record-tight_decl.ml.ref | 77 + test/passing/refs.default/record.ml.err | 2 + test/passing/refs.default/record.ml.ref | 77 + .../refs.default/record_punning.ml.ref | 69 + .../refs.default/reformat_string.ml.ref | 10 + test/passing/refs.default/refs.ml.err | 2 + test/passing/refs.default/refs.ml.ref | 20 + .../refs.default/remove_extra_parens.ml.ref | 1 + test/passing/refs.default/repl.ml.ref | 7 + test/passing/refs.default/repl.mli.err | 4 + .../{tests => refs.default}/repl.mli.ref | 10 +- test/passing/refs.default/revapply_ext.ml.ref | 9 + test/passing/refs.default/send.ml.ref | 9 + .../refs.default/sequence-preserve.ml.ref | 145 + test/passing/refs.default/sequence.ml.ref | 131 + test/passing/refs.default/shebang.ml.ref | 5 + .../refs.default/shortcut_ext_attr.ml.ref | 126 + test/passing/refs.default/sig_value.mli.ref | 21 + test/passing/refs.default/single_line.mli.ref | 6 + test/passing/refs.default/skip.ml.ref | 113 + test/passing/refs.default/source.ml.err | 5 + .../source.ml.ref} | 0 test/passing/refs.default/str_value.ml.ref | 75 + test/passing/refs.default/string.ml.ref | 45 + test/passing/refs.default/string_array.ml.ref | 14 + .../refs.default/string_wrapping.ml.ref | 3 + test/passing/refs.default/symbol.ml.ref | 21 + test/passing/refs.default/tag_only.ml.ref | 194 + test/passing/refs.default/tag_only.mli.ref | 99 + .../refs.default/try_with_or_pattern.ml.ref | 5 + test/passing/refs.default/tuple.ml.ref | 47 + .../refs.default/tuple_less_parens.ml.ref | 45 + .../refs.default/tuple_type_parens.ml.ref | 4 + .../refs.default/type_and_constraint.ml.ref | 1 + .../refs.default/type_annotations.ml.ref | 7 + .../types-compact-space_around-docked.ml.ref | 201 + .../types-compact-space_around.ml.ref | 201 + .../passing/refs.default/types-compact.ml.ref | 201 + test/passing/refs.default/types-indent.ml.ref | 201 + .../types-sparse-space_around.ml.ref | 256 + test/passing/refs.default/types-sparse.ml.ref | 256 + test/passing/refs.default/types.ml.ref | 201 + test/passing/refs.default/unary.ml.ref | 34 + test/passing/refs.default/unary_hash.ml.ref | 10 + test/passing/refs.default/unicode.ml.err | 2 + .../{tests => refs.default}/unicode.ml.ref | 0 test/passing/refs.default/use_file.mlt.ref | 19 + test/passing/refs.default/variants.ml.err | 1 + test/passing/refs.default/variants.ml.ref | 15 + .../verbatim_comments-wrap.ml.ref | 0 .../verbatim_comments.ml.ref | 0 .../{tests => refs.default}/w50.ml.ref | 5 +- .../passing/refs.default/wrap_comments.ml.err | 19 + .../passing/refs.default/wrap_comments.ml.ref | 232 + .../refs.default/wrap_comments_break.ml.ref | 8 + .../wrap_invalid_doc_comments.ml.err | 6 + .../wrap_invalid_doc_comments.ml.ref | 2 + .../refs.default/wrapping_functor_args.ml.err | 1 + .../refs.default/wrapping_functor_args.ml.ref | 44 + test/passing/refs.janestreet/.ocamlformat | 1 + .../refs.janestreet/align_infix.ml.ref | 3 + test/passing/refs.janestreet/alignment.ml.ref | 14 + test/passing/refs.janestreet/apply.ml.ref | 98 + .../refs.janestreet/apply_functor.ml.err | 1 + .../refs.janestreet/apply_functor.ml.ref | 2 + .../refs.janestreet/args_grouped.ml.ref | 113 + test/passing/refs.janestreet/array.ml.ref | 41 + .../assignment_operator-op_begin_line.ml.ref | 58 + .../assignment_operator.ml.ref | 58 + .../attribute_and_expression.ml.ref | 7 + .../passing/refs.janestreet/attributes.ml.err | 1 + .../passing/refs.janestreet/attributes.ml.ref | 467 + .../refs.janestreet/attributes.mli.ref | 6 + test/passing/refs.janestreet/binders.ml.ref | 14 + .../break_before_in-auto.ml.ref | 130 + .../refs.janestreet/break_before_in.ml.ref | 145 + .../refs.janestreet/break_cases-align.ml.err | 1 + .../refs.janestreet/break_cases-align.ml.ref | 343 + .../refs.janestreet/break_cases-all.ml.err | 1 + .../refs.janestreet/break_cases-all.ml.ref | 343 + ...reak_cases-closing_on_separate_line.ml.err | 1 + ...reak_cases-closing_on_separate_line.ml.ref | 361 + ...ng_on_separate_line_fit_or_vertical.ml.err | 1 + ...ng_on_separate_line_fit_or_vertical.ml.ref | 322 + ...te_line_leading_nested_match_parens.ml.err | 1 + ...te_line_leading_nested_match_parens.ml.ref | 361 + .../break_cases-cosl_lnmp_cmei.ml.err | 1 + .../break_cases-cosl_lnmp_cmei.ml.ref | 361 + .../break_cases-fit_or_vertical.ml.err | 1 + .../break_cases-fit_or_vertical.ml.ref | 304 + .../refs.janestreet/break_cases-nested.ml.err | 1 + .../refs.janestreet/break_cases-nested.ml.ref | 271 + .../break_cases-normal_indent.ml.err | 1 + .../break_cases-normal_indent.ml.ref | 343 + .../break_cases-toplevel.ml.err | 1 + .../break_cases-toplevel.ml.ref | 305 + .../break_cases-vertical.ml.err | 1 + .../break_cases-vertical.ml.ref | 384 + .../refs.janestreet/break_cases.ml.err | 1 + .../refs.janestreet/break_cases.ml.ref | 239 + .../break_collection_expressions-wrap.ml.ref | 63 + .../break_collection_expressions.ml.ref | 273 + .../refs.janestreet/break_colon-before.ml.ref | 97 + .../refs.janestreet/break_colon.ml.ref | 97 + .../break_fun_decl-fit_or_vertical.ml.ref | 163 + .../break_fun_decl-smart.ml.ref | 150 + .../break_fun_decl-wrap.ml.ref | 158 + .../refs.janestreet/break_fun_decl.ml.ref | 163 + .../break_infix-fit-or-vertical.ml.ref | 110 + .../refs.janestreet/break_infix-wrap.ml.ref | 92 + .../refs.janestreet/break_infix.ml.ref | 109 + .../refs.janestreet/break_record.ml.ref | 6 + .../break_separators-after.ml.ref | 410 + .../break_separators-after_docked.ml.ref | 429 + .../break_separators-before_docked.ml.ref | 429 + .../refs.janestreet/break_separators.ml.ref | 410 + .../break_sequence_before.ml.ref | 50 + .../break_string_literals-never.ml.err | 6 + .../break_string_literals-never.ml.ref | 62 + .../break_string_literals.ml.ref | 96 + .../refs.janestreet/break_struct.ml.ref | 86 + .../refs.janestreet/cases_exp_grouping.ml.ref | 98 + test/passing/refs.janestreet/cinaps.ml.ref | 76 + .../passing/refs.janestreet/class_expr.ml.ref | 18 + .../refs.janestreet/class_sig-after.mli.ref | 37 + .../passing/refs.janestreet/class_sig.mli.ref | 38 + .../passing/refs.janestreet/class_type.ml.ref | 15 + .../refs.janestreet/cmdline_override.ml.ref | 3 + .../refs.janestreet/cmdline_override2.ml.ref | 3 + test/passing/refs.janestreet/coerce.ml.ref | 30 + .../refs.janestreet/comment_breaking.ml.ref | 10 + .../refs.janestreet/comment_header.ml.ref | 60 + .../refs.janestreet/comment_in_empty.ml.ref | 46 + .../refs.janestreet/comment_in_modules.ml.ref | 31 + .../refs.janestreet/comment_last.ml.ref | 4 + .../refs.janestreet/comment_sparse.ml.ref | 11 + .../refs.janestreet/comments-no-wrap.ml.err | 3 + .../refs.janestreet/comments-no-wrap.ml.ref | 496 + test/passing/refs.janestreet/comments.ml.err | 3 + test/passing/refs.janestreet/comments.ml.ref | 496 + test/passing/refs.janestreet/comments.mli.ref | 7 + .../refs.janestreet/comments_args.ml.ref | 35 + .../comments_around_disabled.ml.ref | 16 + .../comments_in_local_let.ml.ref | 12 + ...nts_in_record-break_separator-after.ml.err | 2 + ...nts_in_record-break_separator-after.ml.ref | 137 + ...ts_in_record-break_separator-before.ml.err | 2 + ...ts_in_record-break_separator-before.ml.ref | 137 + .../refs.janestreet/comments_in_record.ml.err | 2 + .../refs.janestreet/comments_in_record.ml.ref | 137 + .../refs.janestreet/crlf_to_crlf.ml.ref | 43 + .../passing/refs.janestreet/crlf_to_lf.ml.ref | 43 + .../refs.janestreet/custom_list.ml.ref | 5 + .../refs.janestreet/directives.mlt.ref | 7 + .../refs.janestreet/disable_attr.ml.ref | 4 + .../refs.janestreet/disable_class_type.ml.ref | 8 + .../refs.janestreet/disable_conf_attrs.ml.err | 40 + .../refs.janestreet/disable_conf_attrs.ml.ref | 10 + .../refs.janestreet/disable_local_let.ml.ref | 37 + test/passing/refs.janestreet/disabled.ml.ref | 2 + .../refs.janestreet/disabled_attr.ml.ref | 24 + .../refs.janestreet/disambiguate.ml.ref | 95 + .../disambiguated_types.ml.ref | 3 + test/passing/refs.janestreet/doc.mld.err | 8 + test/passing/refs.janestreet/doc.mld.ref | 156 + .../refs.janestreet/doc_comments-after.ml.err | 4 + .../refs.janestreet/doc_comments-after.ml.ref | 308 + .../doc_comments-before-except-val.ml.err | 4 + .../doc_comments-before-except-val.ml.ref | 308 + .../doc_comments-before.ml.err | 4 + .../doc_comments-before.ml.ref | 308 + .../doc_comments-no-parse-docstrings.mli.err | 13 + .../doc_comments-no-parse-docstrings.mli.ref | 663 + .../doc_comments-no-wrap.mli.err | 13 + .../doc_comments-no-wrap.mli.ref | 663 + .../refs.janestreet/doc_comments.ml.err | 4 + .../refs.janestreet/doc_comments.ml.ref | 308 + .../refs.janestreet/doc_comments.mli.err | 13 + .../refs.janestreet/doc_comments.mli.ref | 663 + .../doc_comments_padding.ml.ref | 37 + test/passing/refs.janestreet/doc_repl.mld.ref | 92 + .../docstrings_toplevel_directives.mlt.ref | 11 + test/passing/refs.janestreet/dune | 1 + test/passing/refs.janestreet/dune-project | 1 + .../refs.janestreet/eliom_ext.eliom.err | 1 + .../refs.janestreet/eliom_ext.eliom.ref | 55 + test/passing/refs.janestreet/empty_ml.ml.ref | 3 + .../passing/refs.janestreet/empty_mli.mli.ref | 3 + .../passing/refs.janestreet/empty_mlt.mlt.ref | 3 + test/passing/refs.janestreet/error1.ml.err | 3 + test/passing/refs.janestreet/error2.ml.err | 5 + test/passing/refs.janestreet/error3.ml.err | 11 + test/passing/refs.janestreet/error4.ml.err | 9 + test/passing/refs.janestreet/error4.ml.ref | 5 + .../passing/refs.janestreet/escaped_nl.ml.ref | 24 + .../passing/refs.janestreet/exceptions.ml.ref | 68 + .../refs.janestreet/exceptions.mli.ref | 62 + .../exp_grouping-parens.ml.ref | 411 + .../refs.janestreet/exp_grouping.ml.ref | 480 + .../passing/refs.janestreet/exp_record.ml.ref | 9 + .../refs.janestreet/expect_test.ml.err | 2 + .../refs.janestreet/expect_test.ml.ref | 26 + .../refs.janestreet/extensions-indent.ml.ref | 701 + .../refs.janestreet/extensions-indent.mli.ref | 96 + .../passing/refs.janestreet/extensions.ml.ref | 701 + .../refs.janestreet/extensions.mli.ref | 96 + .../extensions_exp_grouping.ml.ref | 102 + .../field-op_begin_line.ml.ref | 21 + test/passing/refs.janestreet/field.ml.ref | 21 + .../refs.janestreet/first_class_module.ml.ref | 125 + .../refs.janestreet/floating_doc.ml.ref | 11 + test/passing/refs.janestreet/for_while.ml.ref | 55 + .../fun_decl-no-wrap-fun-args.ml.ref | 122 + test/passing/refs.janestreet/fun_decl.ml.ref | 122 + .../refs.janestreet/fun_function.ml.ref | 192 + .../function_indent-never.ml.ref | 51 + .../refs.janestreet/function_indent.ml.ref | 51 + test/passing/refs.janestreet/functor.ml.ref | 88 + test/passing/refs.janestreet/functor.mli.ref | 3 + test/passing/refs.janestreet/funsig.ml.ref | 69 + test/passing/refs.janestreet/gadt.ml.ref | 15 + .../passing/refs.janestreet/generative.ml.ref | 9 + test/passing/refs.janestreet/hash_bang.ml.ref | 3 + .../passing/refs.janestreet/hash_types.ml.ref | 13 + .../{tests => refs.janestreet}/holes.ml.ref | 0 .../{tests => refs.janestreet}/ifand.ml.ref | 1 + test/passing/refs.janestreet/index_op.ml.ref | 159 + .../indicate_multiline_delimiters-cosl.ml.ref | 70 + ...indicate_multiline_delimiters-space.ml.ref | 63 + .../indicate_multiline_delimiters.ml.ref | 63 + .../refs.janestreet/infix_arg_grouping.ml.ref | 175 + .../refs.janestreet/infix_bind-break.ml.ref | 324 + .../infix_bind-fit_or_vertical-break.ml.ref | 330 + .../infix_bind-fit_or_vertical.ml.ref | 293 + .../passing/refs.janestreet/infix_bind.ml.ref | 287 + .../refs.janestreet/infix_precedence.ml.ref | 13 + .../refs.janestreet/injectivity.ml.ref | 76 + .../passing/refs.janestreet/into_infix.ml.ref | 1 + test/passing/refs.janestreet/invalid.ml.ref | 14 + .../refs.janestreet/invalid_docstring.ml.ref | 1 + .../invalid_docstrings.mli.ref | 8 + test/passing/refs.janestreet/issue114.ml.ref | 1 + test/passing/refs.janestreet/issue1750.ml.ref | 79 + test/passing/refs.janestreet/issue289.ml.ref | 73 + test/passing/refs.janestreet/issue48.ml.ref | 3 + test/passing/refs.janestreet/issue51.ml.ref | 1 + test/passing/refs.janestreet/issue57.ml.ref | 6 + test/passing/refs.janestreet/issue60.ml.ref | 1 + test/passing/refs.janestreet/issue77.ml.ref | 10 + test/passing/refs.janestreet/issue85.ml.ref | 7 + test/passing/refs.janestreet/issue89.ml.ref | 1 + .../refs.janestreet/ite-compact.ml.err | 1 + .../refs.janestreet/ite-compact.ml.ref | 179 + .../ite-compact_closing.ml.err | 1 + .../ite-compact_closing.ml.ref | 191 + .../ite-fit_or_vertical.ml.ref | 227 + .../ite-fit_or_vertical_closing.ml.ref | 237 + .../ite-fit_or_vertical_no_indicate.ml.ref | 227 + test/passing/refs.janestreet/ite-kr.ml.ref | 273 + .../refs.janestreet/ite-kr_closing.ml.ref | 280 + .../refs.janestreet/ite-kw_first.ml.err | 1 + .../refs.janestreet/ite-kw_first.ml.ref | 206 + .../ite-kw_first_closing.ml.err | 1 + .../ite-kw_first_closing.ml.ref | 218 + .../ite-kw_first_no_indicate.ml.err | 1 + .../ite-kw_first_no_indicate.ml.ref | 206 + .../refs.janestreet/ite-no_indicate.ml.err | 1 + .../refs.janestreet/ite-no_indicate.ml.ref | 179 + .../refs.janestreet/ite-vertical.ml.ref | 271 + test/passing/refs.janestreet/ite.ml.err | 1 + test/passing/refs.janestreet/ite.ml.ref | 179 + test/passing/refs.janestreet/js_args.ml.ref | 163 + test/passing/refs.janestreet/js_begin.ml.ref | 16 + test/passing/refs.janestreet/js_bind.ml.ref | 19 + test/passing/refs.janestreet/js_fun.ml.ref | 83 + test/passing/refs.janestreet/js_map.ml.ref | 1 + .../passing/refs.janestreet/js_pattern.ml.ref | 51 + test/passing/refs.janestreet/js_poly.ml.ref | 7 + .../js_record.ml.ref | 0 test/passing/refs.janestreet/js_sig.mli.err | 1 + .../{tests => refs.janestreet}/js_sig.mli.ref | 0 test/passing/refs.janestreet/js_source.ml.err | 5 + test/passing/refs.janestreet/js_source.ml.ref | 989 ++ test/passing/refs.janestreet/js_syntax.ml.ref | 13 + test/passing/refs.janestreet/js_to_do.ml.ref | 64 + test/passing/refs.janestreet/js_upon.ml.ref | 16 + .../refs.janestreet/kw_extentions.ml.ref | 72 + .../label_option_default_args.ml.ref | 118 + .../refs.janestreet/labelled_args-414.ml.ref | 46 + .../refs.janestreet/labelled_args.ml.ref | 46 + test/passing/refs.janestreet/lazy.ml.ref | 22 + .../let_binding-deindent-fun.ml.ref | 318 + .../let_binding-in_indent.ml.ref | 318 + .../refs.janestreet/let_binding-indent.ml.ref | 318 + .../refs.janestreet/let_binding.ml.ref | 318 + ...et_binding_spacing-double-semicolon.ml.ref | 10 + .../let_binding_spacing-sparse.ml.ref | 10 + .../let_binding_spacing.ml.ref | 10 + .../refs.janestreet/let_in_constr.ml.ref | 5 + .../refs.janestreet/let_module-sparse.ml.ref | 80 + .../passing/refs.janestreet/let_module.ml.ref | 76 + .../refs.janestreet/let_punning.ml.ref | 20 + .../refs.janestreet/line_directives.ml.err | 5 + .../refs.janestreet/list-space_around.ml.ref | 106 + test/passing/refs.janestreet/list.ml.ref | 106 + .../refs.janestreet/list_and_comments.ml.ref | 1 + .../refs.janestreet/list_normalized.ml.ref | 56 + test/passing/refs.janestreet/loc_stack.ml.ref | 47 + .../locally_abtract_types.ml.ref | 14 + test/passing/refs.janestreet/margin_80.ml.ref | 33 + test/passing/refs.janestreet/match.ml.ref | 108 + test/passing/refs.janestreet/match2.ml.ref | 143 + .../refs.janestreet/match_indent-never.ml.ref | 22 + .../refs.janestreet/match_indent.ml.ref | 22 + .../passing/refs.janestreet/max_indent.ml.err | 1 + .../passing/refs.janestreet/max_indent.ml.ref | 104 + .../refs.janestreet/mod_type_subst.ml.ref | 179 + test/passing/refs.janestreet/module.ml.ref | 113 + .../refs.janestreet/module_anonymous.ml.ref | 30 + .../refs.janestreet/module_attributes.ml.ref | 43 + .../module_item_spacing-preserve.ml.ref | 144 + .../module_item_spacing-sparse.ml.ref | 165 + .../module_item_spacing.ml.ref | 132 + .../module_item_spacing.mli.ref | 114 + .../refs.janestreet/module_type.ml.err | 1 + .../refs.janestreet/module_type.ml.ref | 112 + .../refs.janestreet/module_type.mli.ref | 4 + .../refs.janestreet/monadic_binding.ml.ref | 39 + .../refs.janestreet/multi_index_op.ml.ref | 13 + .../refs.janestreet/named_existentials.ml.ref | 32 + .../refs.janestreet/need_format.ml.err | 1 + test/passing/refs.janestreet/new.ml.ref | 8 + test/passing/refs.janestreet/object.ml.ref | 275 + test/passing/refs.janestreet/object2.ml.ref | 28 + .../refs.janestreet/object_expr-414.ml.ref | 24 + .../refs.janestreet/object_expr.ml.ref | 24 + .../refs.janestreet/object_type.ml.ref | 72 + test/passing/refs.janestreet/obuild.ml.ref | 12 + ...ocp_indent_compat-break_colon_after.ml.ref | 101 + .../refs.janestreet/ocp_indent_compat.ml.ref | 101 + .../refs.janestreet/ocp_indent_options.ml.ref | 11 + .../open-closing-on-separate-line.ml.ref | 380 + test/passing/refs.janestreet/open.ml.err | 1 + test/passing/refs.janestreet/open.ml.ref | 370 + .../passing/refs.janestreet/open_types.ml.ref | 2 + test/passing/refs.janestreet/option.ml.err | 29 + test/passing/refs.janestreet/option.ml.ref | 75 + test/passing/refs.janestreet/override.ml.ref | 5 + .../parens_tuple_patterns.ml.ref | 5 + test/passing/refs.janestreet/polytypes.ml.err | 1 + .../polytypes.ml.ref} | 0 .../pre_post_extensions.ml.ref | 17 + .../passing/refs.janestreet/precedence.ml.ref | 3 + .../refs.janestreet/prefix_infix.ml.ref | 15 + test/passing/refs.janestreet/profiles.ml.ref | 9 + test/passing/refs.janestreet/profiles2.ml.ref | 2 + .../protected_object_types.ml.ref | 86 + test/passing/refs.janestreet/qtest.ml.err | 1 + test/passing/refs.janestreet/qtest.ml.ref | 59 + .../refs.janestreet/quoted_strings.ml.ref | 38 + test/passing/refs.janestreet/recmod.mli.ref | 19 + .../passing/refs.janestreet/record-402.ml.err | 2 + .../passing/refs.janestreet/record-402.ml.ref | 101 + .../refs.janestreet/record-loose.ml.err | 2 + .../refs.janestreet/record-loose.ml.ref | 101 + .../refs.janestreet/record-tight_decl.ml.err | 2 + .../refs.janestreet/record-tight_decl.ml.ref | 101 + test/passing/refs.janestreet/record.ml.err | 2 + test/passing/refs.janestreet/record.ml.ref | 101 + .../record_punning.ml.ref} | 0 .../refs.janestreet/reformat_string.ml.ref | 14 + test/passing/refs.janestreet/refs.ml.ref | 13 + .../remove_extra_parens.ml.ref | 3 + test/passing/refs.janestreet/repl.ml.ref | 8 + test/passing/refs.janestreet/repl.mli.ref | 99 + .../refs.janestreet/revapply_ext.ml.ref | 10 + test/passing/refs.janestreet/send.ml.ref | 12 + .../refs.janestreet/sequence-preserve.ml.ref | 163 + test/passing/refs.janestreet/sequence.ml.ref | 149 + test/passing/refs.janestreet/shebang.ml.ref | 8 + .../refs.janestreet/shortcut_ext_attr.ml.ref | 131 + .../passing/refs.janestreet/sig_value.mli.err | 2 + .../passing/refs.janestreet/sig_value.mli.ref | 19 + .../refs.janestreet/single_line.mli.ref | 6 + test/passing/refs.janestreet/skip.ml.ref | 127 + .../source.ml.ref} | 1014 +- test/passing/refs.janestreet/str_value.ml.ref | 129 + test/passing/refs.janestreet/string.ml.ref | 47 + .../refs.janestreet/string_array.ml.ref | 14 + .../refs.janestreet/string_wrapping.ml.ref | 4 + test/passing/refs.janestreet/symbol.ml.ref | 26 + test/passing/refs.janestreet/tag_only.ml.ref | 181 + test/passing/refs.janestreet/tag_only.mli.ref | 91 + .../try_with_or_pattern.ml.ref | 6 + test/passing/refs.janestreet/tuple.ml.ref | 39 + .../refs.janestreet/tuple_less_parens.ml.ref | 37 + .../refs.janestreet/tuple_type_parens.ml.ref | 4 + .../type_and_constraint.ml.ref | 1 + .../refs.janestreet/type_annotations.ml.ref | 17 + .../types-compact-space_around-docked.ml.err | 1 + .../types-compact-space_around-docked.ml.ref | 190 + .../types-compact-space_around.ml.err | 1 + .../types-compact-space_around.ml.ref | 188 + .../refs.janestreet/types-compact.ml.err | 1 + .../refs.janestreet/types-compact.ml.ref | 188 + .../refs.janestreet/types-indent.ml.ref | 246 + .../types-sparse-space_around.ml.ref | 246 + .../refs.janestreet/types-sparse.ml.ref | 246 + test/passing/refs.janestreet/types.ml.ref | 246 + test/passing/refs.janestreet/unary.ml.ref | 34 + .../passing/refs.janestreet/unary_hash.ml.ref | 10 + test/passing/refs.janestreet/unicode.ml.err | 4 + test/passing/refs.janestreet/unicode.ml.ref | 9 + test/passing/refs.janestreet/use_file.mlt.ref | 19 + test/passing/refs.janestreet/variants.ml.ref | 19 + .../verbatim_comments-wrap.ml.ref | 24 + .../refs.janestreet/verbatim_comments.ml.ref | 24 + test/passing/refs.janestreet/w50.ml.ref | 21 + .../refs.janestreet/wrap_comments.ml.err | 5 + .../refs.janestreet/wrap_comments.ml.ref | 271 + .../wrap_comments_break.ml.ref | 9 + .../wrap_invalid_doc_comments.ml.err | 6 + .../wrap_invalid_doc_comments.ml.ref | 2 + .../wrapping_functor_args.ml.ref | 40 + test/passing/refs.ocamlformat/.ocamlformat | 1 + .../refs.ocamlformat/align_infix.ml.ref | 5 + .../passing/refs.ocamlformat/alignment.ml.err | 1 + .../passing/refs.ocamlformat/alignment.ml.ref | 17 + test/passing/refs.ocamlformat/apply.ml.ref | 89 + .../refs.ocamlformat/apply_functor.ml.ref | 7 + .../refs.ocamlformat/args_grouped.ml.ref | 93 + test/passing/refs.ocamlformat/array.ml.ref | 39 + .../assignment_operator-op_begin_line.ml.err | 1 + .../assignment_operator-op_begin_line.ml.ref | 13 +- .../assignment_operator.ml.err | 1 + .../assignment_operator.ml.ref | 17 +- .../attribute_and_expression.ml.ref | 13 + .../refs.ocamlformat/attributes.ml.err | 3 + .../refs.ocamlformat/attributes.ml.ref | 457 + .../refs.ocamlformat/attributes.mli.ref | 8 + test/passing/refs.ocamlformat/binders.ml.ref | 17 + .../break_before_in-auto.ml.err | 1 + .../break_before_in-auto.ml.ref | 55 + .../refs.ocamlformat/break_before_in.ml.ref | 66 + .../refs.ocamlformat/break_cases-align.ml.err | 3 + .../break_cases-align.ml.ref | 19 +- .../refs.ocamlformat/break_cases-all.ml.err | 3 + .../break_cases-all.ml.ref | 19 +- ...reak_cases-closing_on_separate_line.ml.err | 3 + ...reak_cases-closing_on_separate_line.ml.ref | 19 +- ...ng_on_separate_line_fit_or_vertical.ml.err | 3 + ...ng_on_separate_line_fit_or_vertical.ml.ref | 25 +- ...te_line_leading_nested_match_parens.ml.err | 3 + ...te_line_leading_nested_match_parens.ml.ref | 19 +- .../break_cases-cosl_lnmp_cmei.ml.err | 3 + .../break_cases-cosl_lnmp_cmei.ml.ref | 19 +- .../break_cases-fit_or_vertical.ml.err | 3 + .../break_cases-fit_or_vertical.ml.ref | 25 +- .../break_cases-nested.ml.err | 3 + .../break_cases-nested.ml.ref | 22 +- .../break_cases-normal_indent.ml.err | 3 + .../break_cases-normal_indent.ml.ref | 19 +- .../break_cases-toplevel.ml.err | 3 + .../break_cases-toplevel.ml.ref | 29 +- .../break_cases-vertical.ml.err | 3 + .../break_cases-vertical.ml.ref | 19 +- .../refs.ocamlformat/break_cases.ml.err | 3 + .../break_cases.ml.ref | 29 +- .../break_collection_expressions-wrap.ml.err | 1 + .../break_collection_expressions-wrap.ml.ref | 26 +- .../break_collection_expressions.ml.err | 1 + .../break_collection_expressions.ml.ref | 9 +- .../break_colon-before.ml.ref | 7 +- .../refs.ocamlformat/break_colon.ml.ref | 92 + .../break_fun_decl-fit_or_vertical.ml.ref | 7 +- .../break_fun_decl-smart.ml.ref | 7 +- .../break_fun_decl-wrap.ml.ref | 7 +- .../refs.ocamlformat/break_fun_decl.ml.ref | 124 + .../break_infix-fit-or-vertical.ml.err | 1 + .../break_infix-fit-or-vertical.ml.ref | 3 +- .../refs.ocamlformat/break_infix-wrap.ml.err | 1 + .../break_infix-wrap.ml.ref | 7 +- .../refs.ocamlformat/break_infix.ml.err | 1 + .../break_infix.ml.ref | 3 +- .../refs.ocamlformat/break_record.ml.ref | 2 + .../break_separators-after.ml.err | 1 + .../break_separators-after.ml.ref | 32 +- .../break_separators-after_docked.ml.err | 1 + .../break_separators-after_docked.ml.ref | 37 +- .../break_separators-before_docked.ml.err | 1 + .../break_separators-before_docked.ml.ref | 31 +- .../refs.ocamlformat/break_separators.ml.err | 1 + .../refs.ocamlformat/break_separators.ml.ref | 378 + .../break_sequence_before.ml.ref | 47 + .../break_string_literals-never.ml.err | 6 + .../break_string_literals-never.ml.ref | 0 .../break_string_literals.ml.ref | 22 +- .../break_struct.ml.ref | 0 .../cases_exp_grouping.ml.ref | 0 .../{tests => refs.ocamlformat}/cinaps.ml.ref | 4 +- .../refs.ocamlformat/class_expr.ml.ref | 22 + .../class_sig-after.mli.ref | 0 .../class_sig.mli.ref | 0 .../class_type.ml.ref | 0 .../refs.ocamlformat/cmdline_override.ml.ref | 3 + .../refs.ocamlformat/cmdline_override2.ml.ref | 3 + test/passing/refs.ocamlformat/coerce.ml.ref | 29 + .../refs.ocamlformat/comment_breaking.ml.ref | 8 + .../refs.ocamlformat/comment_header.ml.ref | 60 + .../refs.ocamlformat/comment_in_empty.ml.ref | 51 + .../comment_in_modules.ml.ref | 3 +- .../refs.ocamlformat/comment_last.ml.ref | 5 + .../refs.ocamlformat/comment_sparse.ml.ref | 10 + .../refs.ocamlformat/comments-no-wrap.ml.err | 3 + .../comments-no-wrap.ml.ref | 47 +- test/passing/refs.ocamlformat/comments.ml.err | 3 + .../comments.ml.ref | 71 +- .../passing/refs.ocamlformat/comments.mli.ref | 7 + .../refs.ocamlformat/comments_args.ml.ref | 33 + .../comments_around_disabled.ml.ref | 16 + .../comments_in_local_let.ml.ref | 11 + ...nts_in_record-break_separator-after.ml.err | 3 + ...nts_in_record-break_separator-after.ml.ref | 16 +- ...ts_in_record-break_separator-before.ml.err | 3 + ...ts_in_record-break_separator-before.ml.ref | 16 +- .../comments_in_record.ml.err | 3 + .../comments_in_record.ml.ref | 16 +- .../crlf_to_crlf.ml.ref | 3 +- .../crlf_to_lf.ml.ref | 3 +- .../refs.ocamlformat/custom_list.ml.ref | 3 + .../refs.ocamlformat/directives.mlt.ref | 7 + .../refs.ocamlformat/disable_attr.ml.ref | 4 + .../disable_class_type.ml.ref | 8 + .../disable_conf_attrs.ml.err | 40 + .../disable_conf_attrs.ml.ref | 0 .../refs.ocamlformat/disable_local_let.ml.ref | 35 + test/passing/refs.ocamlformat/disabled.ml.ref | 2 + .../refs.ocamlformat/disabled_attr.ml.ref | 21 + .../refs.ocamlformat/disambiguate.ml.ref | 32 + .../disambiguated_types.ml.ref | 5 + test/passing/refs.ocamlformat/doc.mld.ref | 164 + .../doc_comments-after.ml.err | 4 + .../doc_comments-after.ml.ref | 320 + .../doc_comments-before-except-val.ml.err | 4 + .../doc_comments-before-except-val.ml.ref | 320 + .../doc_comments-before.ml.err | 4 + .../doc_comments-before.ml.ref | 320 + .../doc_comments-no-parse-docstrings.mli.err | 20 + .../doc_comments-no-parse-docstrings.mli.ref | 0 .../doc_comments-no-wrap.mli.err | 20 + .../doc_comments-no-wrap.mli.ref | 656 + .../refs.ocamlformat/doc_comments.ml.err | 4 + .../refs.ocamlformat/doc_comments.ml.ref | 320 + .../refs.ocamlformat/doc_comments.mli.err | 20 + .../refs.ocamlformat/doc_comments.mli.ref | 656 + .../doc_comments_padding.ml.ref | 21 + .../doc_repl.mld.ref | 0 .../docstrings_toplevel_directives.mlt.ref | 11 + test/passing/refs.ocamlformat/dune | 1 + test/passing/refs.ocamlformat/dune-project | 1 + .../refs.ocamlformat/eliom_ext.eliom.err | 1 + .../refs.ocamlformat/eliom_ext.eliom.ref | 49 + test/passing/refs.ocamlformat/empty_ml.ml.ref | 3 + .../refs.ocamlformat/empty_mli.mli.ref | 3 + .../refs.ocamlformat/empty_mlt.mlt.ref | 3 + test/passing/refs.ocamlformat/error1.ml.err | 3 + test/passing/refs.ocamlformat/error2.ml.err | 5 + test/passing/refs.ocamlformat/error3.ml.err | 11 + test/passing/refs.ocamlformat/error4.ml.err | 9 + test/passing/refs.ocamlformat/error4.ml.ref | 5 + .../escaped_nl.ml.ref | 6 +- .../refs.ocamlformat/exceptions.ml.ref | 110 + .../refs.ocamlformat/exceptions.mli.ref | 105 + .../exp_grouping-parens.ml.ref | 27 +- .../exp_grouping.ml.ref | 31 +- .../refs.ocamlformat/exp_record.ml.ref | 13 + .../refs.ocamlformat/expect_test.ml.err | 3 + .../refs.ocamlformat/expect_test.ml.ref | 25 + .../extensions-indent.ml.ref | 3 +- .../extensions-indent.mli.ref | 0 .../extensions.ml.ref | 3 +- .../refs.ocamlformat/extensions.mli.ref | 92 + .../extensions_exp_grouping.ml.ref | 93 + .../field-op_begin_line.ml.ref | 0 test/passing/refs.ocamlformat/field.ml.ref | 26 + .../first_class_module.ml.ref | 0 .../refs.ocamlformat/floating_doc.ml.ref | 11 + .../passing/refs.ocamlformat/for_while.ml.ref | 50 + .../fun_decl-no-wrap-fun-args.ml.ref | 33 +- .../fun_decl.ml.ref | 29 +- .../refs.ocamlformat/fun_function.ml.ref | 131 + .../function_indent-never.ml.ref | 55 + .../refs.ocamlformat/function_indent.ml.ref | 55 + test/passing/refs.ocamlformat/functor.ml.err | 2 + .../functor.ml.ref | 6 +- test/passing/refs.ocamlformat/functor.mli.ref | 3 + test/passing/refs.ocamlformat/funsig.ml.ref | 70 + test/passing/refs.ocamlformat/gadt.ml.ref | 19 + .../generative.ml.ref | 0 .../passing/refs.ocamlformat/hash_bang.ml.ref | 3 + .../refs.ocamlformat/hash_types.ml.ref | 13 + test/passing/refs.ocamlformat/holes.ml.ref | 11 + test/passing/refs.ocamlformat/ifand.ml.ref | 3 + test/passing/refs.ocamlformat/index_op.ml.ref | 207 + .../indicate_multiline_delimiters-cosl.ml.ref | 33 +- ...indicate_multiline_delimiters-space.ml.ref | 33 +- .../indicate_multiline_delimiters.ml.ref | 58 + .../infix_arg_grouping.ml.ref | 22 +- .../infix_bind-break.ml.ref | 32 +- .../infix_bind-fit_or_vertical-break.ml.ref | 27 +- .../infix_bind-fit_or_vertical.ml.ref | 48 +- .../refs.ocamlformat/infix_bind.ml.ref | 246 + .../refs.ocamlformat/infix_precedence.ml.ref | 13 + .../refs.ocamlformat/injectivity.ml.ref | 90 + .../refs.ocamlformat/into_infix.ml.ref | 1 + test/passing/refs.ocamlformat/invalid.ml.ref | 13 + .../refs.ocamlformat/invalid_docstring.ml.ref | 1 + .../invalid_docstrings.mli.ref | 8 + test/passing/refs.ocamlformat/issue114.ml.ref | 1 + .../passing/refs.ocamlformat/issue1750.ml.err | 1 + .../passing/refs.ocamlformat/issue1750.ml.ref | 79 + test/passing/refs.ocamlformat/issue289.ml.ref | 94 + test/passing/refs.ocamlformat/issue48.ml.ref | 3 + test/passing/refs.ocamlformat/issue51.ml.ref | 2 + test/passing/refs.ocamlformat/issue57.ml.ref | 5 + test/passing/refs.ocamlformat/issue60.ml.ref | 1 + test/passing/refs.ocamlformat/issue77.ml.ref | 8 + test/passing/refs.ocamlformat/issue85.ml.ref | 5 + test/passing/refs.ocamlformat/issue89.ml.ref | 1 + .../ite-compact.ml.ref | 15 +- .../ite-compact_closing.ml.ref | 24 +- .../ite-fit_or_vertical.ml.ref | 10 +- .../ite-fit_or_vertical_closing.ml.ref | 22 +- .../ite-fit_or_vertical_no_indicate.ml.err | 3 + .../ite-fit_or_vertical_no_indicate.ml.ref | 19 +- .../{tests => refs.ocamlformat}/ite-kr.ml.ref | 10 +- .../ite-kr_closing.ml.ref | 22 +- .../ite-kw_first.ml.ref | 7 +- .../ite-kw_first_closing.ml.ref | 16 +- .../ite-kw_first_no_indicate.ml.err | 3 + .../ite-kw_first_no_indicate.ml.ref | 13 +- .../refs.ocamlformat/ite-no_indicate.ml.err | 3 + .../ite-no_indicate.ml.ref | 21 +- .../ite-vertical.ml.ref | 10 +- .../{tests => refs.ocamlformat}/ite.ml.ref | 15 +- .../js_args.ml.ref | 22 +- .../js_begin.ml.ref | 0 test/passing/refs.ocamlformat/js_bind.ml.err | 1 + .../js_bind.ml.ref | 9 +- .../{tests => refs.ocamlformat}/js_fun.ml.ref | 0 test/passing/refs.ocamlformat/js_map.ml.ref | 2 + .../js_pattern.ml.ref | 3 +- .../js_poly.ml.ref | 0 .../passing/refs.ocamlformat/js_record.ml.ref | 50 + test/passing/refs.ocamlformat/js_sig.mli.ref | 23 + .../passing/refs.ocamlformat/js_source.ml.err | 7 + .../passing/refs.ocamlformat/js_source.ml.ref | 846 ++ .../js_syntax.ml.ref | 0 .../js_to_do.ml.ref | 34 +- .../js_upon.ml.ref | 8 +- .../refs.ocamlformat/kw_extentions.ml.ref | 52 + .../label_option_default_args.ml.ref | 7 +- .../labelled_args-414.ml.ref | 0 .../refs.ocamlformat/labelled_args.ml.ref | 39 + test/passing/refs.ocamlformat/lazy.ml.ref | 18 + .../let_binding-deindent-fun.ml.ref | 33 +- .../let_binding-in_indent.ml.ref | 30 +- .../let_binding-indent.ml.ref | 34 +- .../let_binding.ml.ref | 30 +- ...et_binding_spacing-double-semicolon.ml.ref | 0 .../let_binding_spacing-sparse.ml.ref | 0 .../let_binding_spacing.ml.ref | 17 + .../refs.ocamlformat/let_in_constr.ml.ref | 4 + .../let_module-sparse.ml.ref | 2 +- .../let_module.ml.ref | 2 +- .../refs.ocamlformat/let_punning.ml.ref | 17 + .../refs.ocamlformat/line_directives.ml.err | 5 + .../list-space_around.ml.ref | 0 test/passing/refs.ocamlformat/list.ml.ref | 88 + .../list_and_comments.ml.ref | 0 .../list_normalized.ml.ref | 3 +- .../loc_stack.ml.ref | 27 +- .../locally_abtract_types.ml.ref | 11 + .../passing/refs.ocamlformat/margin_80.ml.err | 2 + .../margin_80.ml.ref | 0 test/passing/refs.ocamlformat/match.ml.ref | 77 + test/passing/refs.ocamlformat/match2.ml.ref | 111 + .../match_indent-never.ml.ref | 24 + .../refs.ocamlformat/match_indent.ml.ref | 24 + .../refs.ocamlformat/max_indent.ml.ref | 92 + .../refs.ocamlformat/mod_type_subst.ml.ref | 184 + test/passing/refs.ocamlformat/module.ml.ref | 123 + .../refs.ocamlformat/module_anonymous.ml.ref | 30 + .../module_attributes.ml.ref | 0 .../module_item_spacing-preserve.ml.ref | 6 +- .../module_item_spacing-sparse.ml.ref | 6 +- .../module_item_spacing.ml.ref | 6 +- .../module_item_spacing.mli.ref | 0 .../refs.ocamlformat/module_type.ml.err | 2 + .../refs.ocamlformat/module_type.ml.ref | 113 + .../refs.ocamlformat/module_type.mli.err | 1 + .../refs.ocamlformat/module_type.mli.ref | 4 + .../refs.ocamlformat/monadic_binding.ml.ref | 37 + .../refs.ocamlformat/multi_index_op.ml.ref | 14 + .../named_existentials.ml.ref | 26 + .../refs.ocamlformat/need_format.ml.err | 1 + test/passing/refs.ocamlformat/new.ml.ref | 15 + .../{tests => refs.ocamlformat}/object.ml.ref | 0 .../object2.ml.ref | 0 .../object_expr-414.ml.ref | 0 .../object_expr.ml.ref | 0 .../object_type.ml.ref | 0 .../{tests => refs.ocamlformat}/obuild.ml.ref | 0 ...ocp_indent_compat-break_colon_after.ml.ref | 8 +- .../refs.ocamlformat/ocp_indent_compat.ml.ref | 94 + .../ocp_indent_options.ml.ref | 3 +- .../open-closing-on-separate-line.ml.ref | 4 +- .../{tests => refs.ocamlformat}/open.ml.ref | 4 +- .../refs.ocamlformat/open_types.ml.ref | 3 + test/passing/refs.ocamlformat/option.ml.err | 29 + .../{tests => refs.ocamlformat}/option.ml.ref | 0 .../override.ml.ref | 0 .../parens_tuple_patterns.ml.ref | 9 + .../passing/refs.ocamlformat/polytypes.ml.ref | 49 + .../pre_post_extensions.ml.ref | 15 + .../refs.ocamlformat/precedence.ml.ref | 5 + .../refs.ocamlformat/prefix_infix.ml.ref | 27 + test/passing/refs.ocamlformat/profiles.ml.ref | 7 + .../passing/refs.ocamlformat/profiles2.ml.ref | 5 + .../protected_object_types.ml.ref | 90 + test/passing/refs.ocamlformat/qtest.ml.err | 1 + test/passing/refs.ocamlformat/qtest.ml.ref | 59 + .../refs.ocamlformat/quoted_strings.ml.ref | 50 + test/passing/refs.ocamlformat/recmod.mli.ref | 19 + .../refs.ocamlformat/record-402.ml.err | 2 + .../record-402.ml.ref | 3 +- .../refs.ocamlformat/record-loose.ml.err | 2 + .../record-loose.ml.ref | 3 +- .../refs.ocamlformat/record-tight_decl.ml.err | 2 + .../record-tight_decl.ml.ref | 3 +- test/passing/refs.ocamlformat/record.ml.err | 2 + .../{tests => refs.ocamlformat}/record.ml.ref | 3 +- .../record_punning.ml.ref | 0 .../reformat_string.ml.ref | 0 test/passing/refs.ocamlformat/refs.ml.err | 2 + test/passing/refs.ocamlformat/refs.ml.ref | 20 + .../remove_extra_parens.ml.ref | 0 .../{tests => refs.ocamlformat}/repl.ml.ref | 0 test/passing/refs.ocamlformat/repl.mli.ref | 99 + .../refs.ocamlformat/revapply_ext.ml.ref | 9 + test/passing/refs.ocamlformat/send.ml.ref | 11 + .../sequence-preserve.ml.ref | 0 .../sequence.ml.ref | 0 test/passing/refs.ocamlformat/shebang.ml.ref | 5 + .../refs.ocamlformat/shortcut_ext_attr.ml.ref | 152 + .../refs.ocamlformat/sig_value.mli.err | 2 + .../sig_value.mli.ref | 6 +- .../refs.ocamlformat/single_line.mli.ref | 6 + test/passing/refs.ocamlformat/skip.ml.ref | 125 + test/passing/refs.ocamlformat/source.ml.err | 5 + .../{tests => refs.ocamlformat}/source.ml.ref | 1713 ++- .../passing/refs.ocamlformat/str_value.ml.ref | 75 + .../{tests => refs.ocamlformat}/string.ml.ref | 4 +- .../refs.ocamlformat/string_array.ml.ref | 25 + .../refs.ocamlformat/string_wrapping.ml.ref | 3 + test/passing/refs.ocamlformat/symbol.ml.ref | 27 + test/passing/refs.ocamlformat/tag_only.ml.ref | 194 + .../passing/refs.ocamlformat/tag_only.mli.ref | 99 + .../try_with_or_pattern.ml.ref | 5 + test/passing/refs.ocamlformat/tuple.ml.ref | 49 + .../refs.ocamlformat/tuple_less_parens.ml.ref | 47 + .../refs.ocamlformat/tuple_type_parens.ml.ref | 5 + .../type_and_constraint.ml.ref | 1 + .../refs.ocamlformat/type_annotations.ml.ref | 13 + .../types-compact-space_around-docked.ml.ref | 12 +- .../types-compact-space_around.ml.ref | 12 +- .../types-compact.ml.ref | 12 +- .../types-indent.ml.ref | 15 +- .../types-sparse-space_around.ml.ref | 0 .../types-sparse.ml.ref | 12 +- test/passing/refs.ocamlformat/types.ml.ref | 227 + .../{tests => refs.ocamlformat}/unary.ml.ref | 0 .../refs.ocamlformat/unary_hash.ml.ref | 19 + test/passing/refs.ocamlformat/unicode.ml.err | 2 + test/passing/refs.ocamlformat/unicode.ml.ref | 13 + .../passing/refs.ocamlformat/use_file.mlt.ref | 20 + test/passing/refs.ocamlformat/variants.ml.ref | 20 + .../verbatim_comments-wrap.ml.ref | 23 + .../refs.ocamlformat/verbatim_comments.ml.ref | 23 + test/passing/refs.ocamlformat/w50.ml.ref | 21 + .../refs.ocamlformat/wrap_comments.ml.err | 19 + .../wrap_comments.ml.ref | 0 .../wrap_comments_break.ml.ref | 8 + .../wrap_invalid_doc_comments.ml.err | 6 + .../wrap_invalid_doc_comments.ml.ref | 2 + .../wrapping_functor_args.ml.err | 1 + .../wrapping_functor_args.ml.ref | 44 + test/passing/tests/.ocamlformat | 7 - test/passing/tests/.ocp-indent | 0 test/passing/tests/alignment.ml.ref | 18 - .../tests/args_grouped-conventional.ml.err | 27 - .../tests/args_grouped-conventional.ml.opts | 3 - .../tests/args_grouped-conventional.ml.ref | 167 - test/passing/tests/args_grouped.ml.opts | 1 - test/passing/tests/break_record.ml.opts | 1 - test/passing/tests/dir1/.ocamlformat | 1 - test/passing/tests/dir1/dir2/.ocamlformat | 1 - test/passing/tests/dir1/dir2/print_config.ml | 0 test/passing/tests/error1.ml.ref | 0 test/passing/tests/error2.ml.ref | 0 test/passing/tests/error3.ml.ref | 0 test/passing/tests/into_infix.opts | 1 - test/passing/tests/js_record.ml.opts | 1 - test/passing/tests/js_sig.mli.opts | 1 - test/passing/tests/js_source.ml | 7368 +---------- test/passing/tests/js_source.ml.ocp | 10548 ---------------- test/passing/tests/js_source.ml.ocp-opts | 2 - test/passing/tests/js_source.ml.opts | 1 - test/passing/tests/line_directives.ml.ref | 0 test/passing/tests/need_format.ml.ref | 0 test/passing/tests/polytypes-default.ml.opts | 1 - .../passing/tests/polytypes-janestreet.ml.err | 1 - .../tests/polytypes-janestreet.ml.opts | 1 - test/passing/tests/print_config.ml | 0 test/passing/tests/print_config.ml.deps | 2 - test/passing/tests/print_config.ml.enabled-if | 1 - test/passing/tests/print_config.ml.err | 71 - test/passing/tests/print_config.ml.opts | 3 - test/passing/tests/print_config.ml.ref | 0 test/passing/tests/profiles.ml.opts | 1 - test/passing/tests/profiles2.ml.opts | 1 - test/passing/tests/record-default.ml.err | 2 - test/passing/tests/record-default.ml.opts | 2 - test/passing/tests/record_punning-js.ml.opts | 1 - test/passing/tests/reformat_string.ml.opts | 2 +- test/passing/tests/source-conventional.ml.err | 5 - .../passing/tests/source-conventional.ml.opts | 1 - test/passing/tests/verbose1.ml | 0 test/passing/tests/verbose1.ml.enabled-if | 1 - test/passing/tests/verbose1.ml.err | 71 - test/passing/tests/verbose1.ml.opts | 3 - test/passing/tests/verbose1.ml.ref | 0 test/passing/tests/wrap_comments.ml.opts | 1 - 1165 files changed, 79009 insertions(+), 26884 deletions(-) delete mode 100644 test/passing/dune delete mode 100644 test/passing/dune.inc create mode 100644 test/passing/gen/dune.inc create mode 100644 test/passing/refs.default/.ocamlformat create mode 100644 test/passing/refs.default/align_infix.ml.ref create mode 100644 test/passing/refs.default/alignment.ml.ref create mode 100644 test/passing/refs.default/apply.ml.ref create mode 100644 test/passing/refs.default/apply_functor.ml.ref create mode 100644 test/passing/refs.default/args_grouped.ml.ref create mode 100644 test/passing/refs.default/array.ml.ref create mode 100644 test/passing/refs.default/assignment_operator-op_begin_line.ml.err create mode 100644 test/passing/refs.default/assignment_operator-op_begin_line.ml.ref create mode 100644 test/passing/refs.default/assignment_operator.ml.err create mode 100644 test/passing/refs.default/assignment_operator.ml.ref create mode 100644 test/passing/refs.default/attribute_and_expression.ml.ref create mode 100644 test/passing/refs.default/attributes.ml.err create mode 100644 test/passing/refs.default/attributes.ml.ref rename test/passing/{tests => refs.default}/attributes.mli.ref (100%) create mode 100644 test/passing/refs.default/binders.ml.ref create mode 100644 test/passing/refs.default/break_before_in-auto.ml.err rename test/passing/{tests => refs.default}/break_before_in-auto.ml.ref (84%) create mode 100644 test/passing/refs.default/break_before_in.ml.ref create mode 100644 test/passing/refs.default/break_cases-align.ml.err create mode 100644 test/passing/refs.default/break_cases-align.ml.ref create mode 100644 test/passing/refs.default/break_cases-all.ml.err create mode 100644 test/passing/refs.default/break_cases-all.ml.ref create mode 100644 test/passing/refs.default/break_cases-closing_on_separate_line.ml.err create mode 100644 test/passing/refs.default/break_cases-closing_on_separate_line.ml.ref create mode 100644 test/passing/refs.default/break_cases-closing_on_separate_line_fit_or_vertical.ml.err create mode 100644 test/passing/refs.default/break_cases-closing_on_separate_line_fit_or_vertical.ml.ref create mode 100644 test/passing/refs.default/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err create mode 100644 test/passing/refs.default/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref create mode 100644 test/passing/refs.default/break_cases-cosl_lnmp_cmei.ml.err create mode 100644 test/passing/refs.default/break_cases-cosl_lnmp_cmei.ml.ref create mode 100644 test/passing/refs.default/break_cases-fit_or_vertical.ml.err create mode 100644 test/passing/refs.default/break_cases-fit_or_vertical.ml.ref create mode 100644 test/passing/refs.default/break_cases-nested.ml.err create mode 100644 test/passing/refs.default/break_cases-nested.ml.ref create mode 100644 test/passing/refs.default/break_cases-normal_indent.ml.err create mode 100644 test/passing/refs.default/break_cases-normal_indent.ml.ref create mode 100644 test/passing/refs.default/break_cases-toplevel.ml.err create mode 100644 test/passing/refs.default/break_cases-toplevel.ml.ref create mode 100644 test/passing/refs.default/break_cases-vertical.ml.err create mode 100644 test/passing/refs.default/break_cases-vertical.ml.ref create mode 100644 test/passing/refs.default/break_cases.ml.err create mode 100644 test/passing/refs.default/break_cases.ml.ref create mode 100644 test/passing/refs.default/break_collection_expressions-wrap.ml.ref create mode 100644 test/passing/refs.default/break_collection_expressions.ml.ref create mode 100644 test/passing/refs.default/break_colon-before.ml.ref create mode 100644 test/passing/refs.default/break_colon.ml.ref create mode 100644 test/passing/refs.default/break_fun_decl-fit_or_vertical.ml.ref create mode 100644 test/passing/refs.default/break_fun_decl-smart.ml.ref create mode 100644 test/passing/refs.default/break_fun_decl-wrap.ml.ref create mode 100644 test/passing/refs.default/break_fun_decl.ml.ref create mode 100644 test/passing/refs.default/break_infix-fit-or-vertical.ml.err create mode 100644 test/passing/refs.default/break_infix-fit-or-vertical.ml.ref create mode 100644 test/passing/refs.default/break_infix-wrap.ml.err create mode 100644 test/passing/refs.default/break_infix-wrap.ml.ref create mode 100644 test/passing/refs.default/break_infix.ml.err create mode 100644 test/passing/refs.default/break_infix.ml.ref create mode 100644 test/passing/refs.default/break_record.ml.ref create mode 100644 test/passing/refs.default/break_separators-after.ml.ref create mode 100644 test/passing/refs.default/break_separators-after_docked.ml.ref create mode 100644 test/passing/refs.default/break_separators-before_docked.ml.ref create mode 100644 test/passing/refs.default/break_separators.ml.ref create mode 100644 test/passing/refs.default/break_sequence_before.ml.ref create mode 100644 test/passing/refs.default/break_string_literals-never.ml.err create mode 100644 test/passing/refs.default/break_string_literals-never.ml.ref create mode 100644 test/passing/refs.default/break_string_literals.ml.ref create mode 100644 test/passing/refs.default/break_struct.ml.ref create mode 100644 test/passing/refs.default/cases_exp_grouping.ml.ref create mode 100644 test/passing/refs.default/cinaps.ml.ref create mode 100644 test/passing/refs.default/class_expr.ml.err create mode 100644 test/passing/refs.default/class_expr.ml.ref create mode 100644 test/passing/refs.default/class_sig-after.mli.ref create mode 100644 test/passing/refs.default/class_sig.mli.ref create mode 100644 test/passing/refs.default/class_type.ml.ref create mode 100644 test/passing/refs.default/cmdline_override.ml.ref create mode 100644 test/passing/refs.default/cmdline_override2.ml.ref create mode 100644 test/passing/refs.default/coerce.ml.ref create mode 100644 test/passing/refs.default/comment_breaking.ml.ref rename test/passing/{tests => refs.default}/comment_header.ml.ref (98%) create mode 100644 test/passing/refs.default/comment_in_empty.ml.ref create mode 100644 test/passing/refs.default/comment_in_modules.ml.ref create mode 100644 test/passing/refs.default/comment_last.ml.ref create mode 100644 test/passing/refs.default/comment_sparse.ml.ref create mode 100644 test/passing/refs.default/comments-no-wrap.ml.err create mode 100644 test/passing/refs.default/comments-no-wrap.ml.ref create mode 100644 test/passing/refs.default/comments.ml.err create mode 100644 test/passing/refs.default/comments.ml.ref create mode 100644 test/passing/refs.default/comments.mli.ref rename test/passing/{tests => refs.default}/comments_args.ml.ref (100%) rename test/passing/{tests => refs.default}/comments_around_disabled.ml.ref (100%) create mode 100644 test/passing/refs.default/comments_in_local_let.ml.ref create mode 100644 test/passing/refs.default/comments_in_record-break_separator-after.ml.err create mode 100644 test/passing/refs.default/comments_in_record-break_separator-after.ml.ref create mode 100644 test/passing/refs.default/comments_in_record-break_separator-before.ml.err create mode 100644 test/passing/refs.default/comments_in_record-break_separator-before.ml.ref create mode 100644 test/passing/refs.default/comments_in_record.ml.err create mode 100644 test/passing/refs.default/comments_in_record.ml.ref create mode 100644 test/passing/refs.default/crlf_to_crlf.ml.ref create mode 100644 test/passing/refs.default/crlf_to_lf.ml.ref create mode 100644 test/passing/refs.default/custom_list.ml.ref rename test/passing/{tests => refs.default}/directives.mlt.ref (100%) create mode 100644 test/passing/refs.default/disable_attr.ml.ref create mode 100644 test/passing/refs.default/disable_class_type.ml.ref create mode 100644 test/passing/refs.default/disable_conf_attrs.ml.err create mode 100644 test/passing/refs.default/disable_conf_attrs.ml.ref create mode 100644 test/passing/refs.default/disable_local_let.ml.ref create mode 100644 test/passing/refs.default/disabled.ml.ref create mode 100644 test/passing/refs.default/disabled_attr.ml.ref create mode 100644 test/passing/refs.default/disambiguate.ml.ref create mode 100644 test/passing/refs.default/disambiguated_types.ml.ref rename test/passing/{tests => refs.default}/doc.mld.ref (87%) create mode 100644 test/passing/refs.default/doc_comments-after.ml.err rename test/passing/{tests => refs.default}/doc_comments-after.ml.ref (94%) create mode 100644 test/passing/refs.default/doc_comments-before-except-val.ml.err rename test/passing/{tests => refs.default}/doc_comments-before-except-val.ml.ref (94%) create mode 100644 test/passing/refs.default/doc_comments-before.ml.err rename test/passing/{tests => refs.default}/doc_comments-before.ml.ref (94%) create mode 100644 test/passing/refs.default/doc_comments-no-parse-docstrings.mli.err create mode 100644 test/passing/refs.default/doc_comments-no-parse-docstrings.mli.ref create mode 100644 test/passing/refs.default/doc_comments-no-wrap.mli.err rename test/passing/{tests => refs.default}/doc_comments-no-wrap.mli.ref (83%) create mode 100644 test/passing/refs.default/doc_comments.ml.err rename test/passing/{tests => refs.default}/doc_comments.ml.ref (94%) create mode 100644 test/passing/refs.default/doc_comments.mli.err rename test/passing/{tests => refs.default}/doc_comments.mli.ref (82%) create mode 100644 test/passing/refs.default/doc_comments_padding.ml.ref create mode 100644 test/passing/refs.default/doc_repl.mld.ref create mode 100644 test/passing/refs.default/docstrings_toplevel_directives.mlt.ref create mode 100644 test/passing/refs.default/dune create mode 100644 test/passing/refs.default/dune-project create mode 100644 test/passing/refs.default/eliom_ext.eliom.ref create mode 100644 test/passing/refs.default/empty_ml.ml.ref create mode 100644 test/passing/refs.default/empty_mli.mli.ref create mode 100644 test/passing/refs.default/empty_mlt.mlt.ref create mode 100644 test/passing/refs.default/error1.ml.err create mode 100644 test/passing/refs.default/error2.ml.err create mode 100644 test/passing/refs.default/error3.ml.err create mode 100644 test/passing/refs.default/error4.ml.err rename test/passing/{tests => refs.default}/error4.ml.ref (100%) create mode 100644 test/passing/refs.default/escaped_nl.ml.ref create mode 100644 test/passing/refs.default/exceptions.ml.ref create mode 100644 test/passing/refs.default/exceptions.mli.ref create mode 100644 test/passing/refs.default/exp_grouping-parens.ml.ref create mode 100644 test/passing/refs.default/exp_grouping.ml.ref create mode 100644 test/passing/refs.default/exp_record.ml.ref create mode 100644 test/passing/refs.default/expect_test.ml.err create mode 100644 test/passing/refs.default/expect_test.ml.ref create mode 100644 test/passing/refs.default/extensions-indent.ml.ref create mode 100644 test/passing/refs.default/extensions-indent.mli.ref create mode 100644 test/passing/refs.default/extensions.ml.ref create mode 100644 test/passing/refs.default/extensions.mli.ref rename test/passing/{tests => refs.default}/extensions_exp_grouping.ml.ref (80%) create mode 100644 test/passing/refs.default/field-op_begin_line.ml.ref create mode 100644 test/passing/refs.default/field.ml.ref create mode 100644 test/passing/refs.default/first_class_module.ml.ref create mode 100644 test/passing/refs.default/floating_doc.ml.ref create mode 100644 test/passing/refs.default/for_while.ml.ref create mode 100644 test/passing/refs.default/fun_decl-no-wrap-fun-args.ml.ref create mode 100644 test/passing/refs.default/fun_decl.ml.ref rename test/passing/{tests => refs.default}/fun_function.ml.ref (89%) rename test/passing/{tests => refs.default}/function_indent-never.ml.ref (80%) rename test/passing/{tests => refs.default}/function_indent.ml.ref (80%) create mode 100644 test/passing/refs.default/functor.ml.err create mode 100644 test/passing/refs.default/functor.ml.ref create mode 100644 test/passing/refs.default/functor.mli.ref create mode 100644 test/passing/refs.default/funsig.ml.ref create mode 100644 test/passing/refs.default/gadt.ml.ref create mode 100644 test/passing/refs.default/generative.ml.ref create mode 100644 test/passing/refs.default/hash_bang.ml.ref create mode 100644 test/passing/refs.default/hash_types.ml.ref create mode 100644 test/passing/refs.default/holes.ml.ref create mode 100644 test/passing/refs.default/ifand.ml.ref create mode 100644 test/passing/refs.default/index_op.ml.ref create mode 100644 test/passing/refs.default/indicate_multiline_delimiters-cosl.ml.ref create mode 100644 test/passing/refs.default/indicate_multiline_delimiters-space.ml.ref create mode 100644 test/passing/refs.default/indicate_multiline_delimiters.ml.ref create mode 100644 test/passing/refs.default/infix_arg_grouping.ml.err create mode 100644 test/passing/refs.default/infix_arg_grouping.ml.ref create mode 100644 test/passing/refs.default/infix_bind-break.ml.ref create mode 100644 test/passing/refs.default/infix_bind-fit_or_vertical-break.ml.ref create mode 100644 test/passing/refs.default/infix_bind-fit_or_vertical.ml.ref create mode 100644 test/passing/refs.default/infix_bind.ml.ref create mode 100644 test/passing/refs.default/infix_precedence.ml.ref create mode 100644 test/passing/refs.default/injectivity.ml.ref rename test/passing/{tests => refs.default}/into_infix.ml.ref (100%) create mode 100644 test/passing/refs.default/invalid.ml.ref create mode 100644 test/passing/refs.default/invalid_docstring.ml.err rename test/passing/{tests => refs.default}/invalid_docstring.ml.ref (100%) rename test/passing/{tests => refs.default}/invalid_docstrings.mli.ref (60%) create mode 100644 test/passing/refs.default/issue114.ml.ref create mode 100644 test/passing/refs.default/issue1750.ml.err create mode 100644 test/passing/refs.default/issue1750.ml.ref create mode 100644 test/passing/refs.default/issue289.ml.err create mode 100644 test/passing/refs.default/issue289.ml.ref create mode 100644 test/passing/refs.default/issue48.ml.ref create mode 100644 test/passing/refs.default/issue51.ml.ref create mode 100644 test/passing/refs.default/issue57.ml.ref create mode 100644 test/passing/refs.default/issue60.ml.ref create mode 100644 test/passing/refs.default/issue77.ml.ref create mode 100644 test/passing/refs.default/issue85.ml.ref create mode 100644 test/passing/refs.default/issue89.ml.ref create mode 100644 test/passing/refs.default/ite-compact.ml.err create mode 100644 test/passing/refs.default/ite-compact.ml.ref create mode 100644 test/passing/refs.default/ite-compact_closing.ml.ref create mode 100644 test/passing/refs.default/ite-fit_or_vertical.ml.err create mode 100644 test/passing/refs.default/ite-fit_or_vertical.ml.ref create mode 100644 test/passing/refs.default/ite-fit_or_vertical_closing.ml.ref create mode 100644 test/passing/refs.default/ite-fit_or_vertical_no_indicate.ml.err create mode 100644 test/passing/refs.default/ite-fit_or_vertical_no_indicate.ml.ref create mode 100644 test/passing/refs.default/ite-kr.ml.ref create mode 100644 test/passing/refs.default/ite-kr_closing.ml.ref create mode 100644 test/passing/refs.default/ite-kw_first.ml.err create mode 100644 test/passing/refs.default/ite-kw_first.ml.ref create mode 100644 test/passing/refs.default/ite-kw_first_closing.ml.ref create mode 100644 test/passing/refs.default/ite-kw_first_no_indicate.ml.err create mode 100644 test/passing/refs.default/ite-kw_first_no_indicate.ml.ref create mode 100644 test/passing/refs.default/ite-no_indicate.ml.err create mode 100644 test/passing/refs.default/ite-no_indicate.ml.ref create mode 100644 test/passing/refs.default/ite-vertical.ml.err create mode 100644 test/passing/refs.default/ite-vertical.ml.ref create mode 100644 test/passing/refs.default/ite.ml.err create mode 100644 test/passing/refs.default/ite.ml.ref create mode 100644 test/passing/refs.default/js_args.ml.ref create mode 100644 test/passing/refs.default/js_begin.ml.ref create mode 100644 test/passing/refs.default/js_bind.ml.ref create mode 100644 test/passing/refs.default/js_fun.ml.ref rename test/passing/{tests => refs.default}/js_map.ml.ref (100%) create mode 100644 test/passing/refs.default/js_pattern.ml.ref create mode 100644 test/passing/refs.default/js_poly.ml.ref create mode 100644 test/passing/refs.default/js_record.ml.ref create mode 100644 test/passing/refs.default/js_sig.mli.ref create mode 100644 test/passing/refs.default/js_source.ml.err create mode 100644 test/passing/refs.default/js_source.ml.ref create mode 100644 test/passing/refs.default/js_syntax.ml.ref create mode 100644 test/passing/refs.default/js_to_do.ml.err create mode 100644 test/passing/refs.default/js_to_do.ml.ref create mode 100644 test/passing/refs.default/js_upon.ml.ref create mode 100644 test/passing/refs.default/kw_extentions.ml.ref create mode 100644 test/passing/refs.default/label_option_default_args.ml.ref create mode 100644 test/passing/refs.default/labelled_args-414.ml.ref create mode 100644 test/passing/refs.default/labelled_args.ml.ref create mode 100644 test/passing/refs.default/lazy.ml.ref create mode 100644 test/passing/refs.default/let_binding-deindent-fun.ml.ref create mode 100644 test/passing/refs.default/let_binding-in_indent.ml.ref create mode 100644 test/passing/refs.default/let_binding-indent.ml.ref create mode 100644 test/passing/refs.default/let_binding.ml.ref create mode 100644 test/passing/refs.default/let_binding_spacing-double-semicolon.ml.ref create mode 100644 test/passing/refs.default/let_binding_spacing-sparse.ml.ref create mode 100644 test/passing/refs.default/let_binding_spacing.ml.ref create mode 100644 test/passing/refs.default/let_in_constr.ml.ref create mode 100644 test/passing/refs.default/let_module-sparse.ml.ref create mode 100644 test/passing/refs.default/let_module.ml.ref create mode 100644 test/passing/refs.default/let_punning.ml.ref create mode 100644 test/passing/refs.default/line_directives.ml.err create mode 100644 test/passing/refs.default/list-space_around.ml.ref create mode 100644 test/passing/refs.default/list.ml.ref create mode 100644 test/passing/refs.default/list_and_comments.ml.ref create mode 100644 test/passing/refs.default/list_normalized.ml.ref create mode 100644 test/passing/refs.default/loc_stack.ml.ref create mode 100644 test/passing/refs.default/locally_abtract_types.ml.ref create mode 100644 test/passing/refs.default/margin_80.ml.err create mode 100644 test/passing/refs.default/margin_80.ml.ref create mode 100644 test/passing/refs.default/match.ml.ref create mode 100644 test/passing/refs.default/match2.ml.ref rename test/passing/{tests => refs.default}/match_indent-never.ml.ref (100%) rename test/passing/{tests => refs.default}/match_indent.ml.ref (100%) create mode 100644 test/passing/refs.default/max_indent.ml.ref create mode 100644 test/passing/refs.default/mod_type_subst.ml.ref create mode 100644 test/passing/refs.default/module.ml.ref create mode 100644 test/passing/refs.default/module_anonymous.ml.ref create mode 100644 test/passing/refs.default/module_attributes.ml.ref create mode 100644 test/passing/refs.default/module_item_spacing-preserve.ml.ref create mode 100644 test/passing/refs.default/module_item_spacing-sparse.ml.ref create mode 100644 test/passing/refs.default/module_item_spacing.ml.ref create mode 100644 test/passing/refs.default/module_item_spacing.mli.ref create mode 100644 test/passing/refs.default/module_type.ml.err create mode 100644 test/passing/refs.default/module_type.ml.ref create mode 100644 test/passing/refs.default/module_type.mli.err rename test/passing/{tests => refs.default}/module_type.mli.ref (100%) create mode 100644 test/passing/refs.default/monadic_binding.ml.ref create mode 100644 test/passing/refs.default/multi_index_op.ml.ref create mode 100644 test/passing/refs.default/named_existentials.ml.ref create mode 100644 test/passing/refs.default/need_format.ml.err create mode 100644 test/passing/refs.default/new.ml.ref create mode 100644 test/passing/refs.default/object.ml.ref create mode 100644 test/passing/refs.default/object2.ml.ref create mode 100644 test/passing/refs.default/object_expr-414.ml.ref create mode 100644 test/passing/refs.default/object_expr.ml.ref create mode 100644 test/passing/refs.default/object_type.ml.ref create mode 100644 test/passing/refs.default/obuild.ml.ref create mode 100644 test/passing/refs.default/ocp_indent_compat-break_colon_after.ml.ref create mode 100644 test/passing/refs.default/ocp_indent_compat.ml.ref create mode 100644 test/passing/refs.default/ocp_indent_options.ml.ref create mode 100644 test/passing/refs.default/open-closing-on-separate-line.ml.ref create mode 100644 test/passing/refs.default/open.ml.err create mode 100644 test/passing/refs.default/open.ml.ref create mode 100644 test/passing/refs.default/open_types.ml.ref create mode 100644 test/passing/refs.default/option.ml.err create mode 100644 test/passing/refs.default/option.ml.ref create mode 100644 test/passing/refs.default/override.ml.ref create mode 100644 test/passing/refs.default/parens_tuple_patterns.ml.ref rename test/passing/{tests/polytypes-default.ml.ref => refs.default/polytypes.ml.ref} (100%) create mode 100644 test/passing/refs.default/pre_post_extensions.ml.ref create mode 100644 test/passing/refs.default/precedence.ml.ref create mode 100644 test/passing/refs.default/prefix_infix.ml.ref create mode 100644 test/passing/refs.default/profiles.ml.ref create mode 100644 test/passing/refs.default/profiles2.ml.ref create mode 100644 test/passing/refs.default/protected_object_types.ml.ref create mode 100644 test/passing/refs.default/qtest.ml.err create mode 100644 test/passing/refs.default/qtest.ml.ref create mode 100644 test/passing/refs.default/quoted_strings.ml.ref create mode 100644 test/passing/refs.default/recmod.mli.ref create mode 100644 test/passing/refs.default/record-402.ml.err create mode 100644 test/passing/refs.default/record-402.ml.ref create mode 100644 test/passing/refs.default/record-loose.ml.err rename test/passing/{tests/record-default.ml.ref => refs.default/record-loose.ml.ref} (100%) create mode 100644 test/passing/refs.default/record-tight_decl.ml.err create mode 100644 test/passing/refs.default/record-tight_decl.ml.ref create mode 100644 test/passing/refs.default/record.ml.err create mode 100644 test/passing/refs.default/record.ml.ref create mode 100644 test/passing/refs.default/record_punning.ml.ref create mode 100644 test/passing/refs.default/reformat_string.ml.ref create mode 100644 test/passing/refs.default/refs.ml.err create mode 100644 test/passing/refs.default/refs.ml.ref create mode 100644 test/passing/refs.default/remove_extra_parens.ml.ref create mode 100644 test/passing/refs.default/repl.ml.ref create mode 100644 test/passing/refs.default/repl.mli.err rename test/passing/{tests => refs.default}/repl.mli.ref (95%) create mode 100644 test/passing/refs.default/revapply_ext.ml.ref create mode 100644 test/passing/refs.default/send.ml.ref create mode 100644 test/passing/refs.default/sequence-preserve.ml.ref create mode 100644 test/passing/refs.default/sequence.ml.ref create mode 100644 test/passing/refs.default/shebang.ml.ref create mode 100644 test/passing/refs.default/shortcut_ext_attr.ml.ref create mode 100644 test/passing/refs.default/sig_value.mli.ref create mode 100644 test/passing/refs.default/single_line.mli.ref create mode 100644 test/passing/refs.default/skip.ml.ref create mode 100644 test/passing/refs.default/source.ml.err rename test/passing/{tests/source-conventional.ml.ref => refs.default/source.ml.ref} (100%) create mode 100644 test/passing/refs.default/str_value.ml.ref create mode 100644 test/passing/refs.default/string.ml.ref create mode 100644 test/passing/refs.default/string_array.ml.ref create mode 100644 test/passing/refs.default/string_wrapping.ml.ref create mode 100644 test/passing/refs.default/symbol.ml.ref create mode 100644 test/passing/refs.default/tag_only.ml.ref create mode 100644 test/passing/refs.default/tag_only.mli.ref create mode 100644 test/passing/refs.default/try_with_or_pattern.ml.ref create mode 100644 test/passing/refs.default/tuple.ml.ref create mode 100644 test/passing/refs.default/tuple_less_parens.ml.ref create mode 100644 test/passing/refs.default/tuple_type_parens.ml.ref create mode 100644 test/passing/refs.default/type_and_constraint.ml.ref create mode 100644 test/passing/refs.default/type_annotations.ml.ref create mode 100644 test/passing/refs.default/types-compact-space_around-docked.ml.ref create mode 100644 test/passing/refs.default/types-compact-space_around.ml.ref create mode 100644 test/passing/refs.default/types-compact.ml.ref create mode 100644 test/passing/refs.default/types-indent.ml.ref create mode 100644 test/passing/refs.default/types-sparse-space_around.ml.ref create mode 100644 test/passing/refs.default/types-sparse.ml.ref create mode 100644 test/passing/refs.default/types.ml.ref create mode 100644 test/passing/refs.default/unary.ml.ref create mode 100644 test/passing/refs.default/unary_hash.ml.ref create mode 100644 test/passing/refs.default/unicode.ml.err rename test/passing/{tests => refs.default}/unicode.ml.ref (100%) create mode 100644 test/passing/refs.default/use_file.mlt.ref create mode 100644 test/passing/refs.default/variants.ml.err create mode 100644 test/passing/refs.default/variants.ml.ref rename test/passing/{tests => refs.default}/verbatim_comments-wrap.ml.ref (100%) rename test/passing/{tests => refs.default}/verbatim_comments.ml.ref (100%) rename test/passing/{tests => refs.default}/w50.ml.ref (81%) create mode 100644 test/passing/refs.default/wrap_comments.ml.err create mode 100644 test/passing/refs.default/wrap_comments.ml.ref create mode 100644 test/passing/refs.default/wrap_comments_break.ml.ref create mode 100644 test/passing/refs.default/wrap_invalid_doc_comments.ml.err create mode 100644 test/passing/refs.default/wrap_invalid_doc_comments.ml.ref create mode 100644 test/passing/refs.default/wrapping_functor_args.ml.err create mode 100644 test/passing/refs.default/wrapping_functor_args.ml.ref create mode 100644 test/passing/refs.janestreet/.ocamlformat create mode 100644 test/passing/refs.janestreet/align_infix.ml.ref create mode 100644 test/passing/refs.janestreet/alignment.ml.ref create mode 100644 test/passing/refs.janestreet/apply.ml.ref create mode 100644 test/passing/refs.janestreet/apply_functor.ml.err create mode 100644 test/passing/refs.janestreet/apply_functor.ml.ref create mode 100644 test/passing/refs.janestreet/args_grouped.ml.ref create mode 100644 test/passing/refs.janestreet/array.ml.ref create mode 100644 test/passing/refs.janestreet/assignment_operator-op_begin_line.ml.ref create mode 100644 test/passing/refs.janestreet/assignment_operator.ml.ref create mode 100644 test/passing/refs.janestreet/attribute_and_expression.ml.ref create mode 100644 test/passing/refs.janestreet/attributes.ml.err create mode 100644 test/passing/refs.janestreet/attributes.ml.ref create mode 100644 test/passing/refs.janestreet/attributes.mli.ref create mode 100644 test/passing/refs.janestreet/binders.ml.ref create mode 100644 test/passing/refs.janestreet/break_before_in-auto.ml.ref create mode 100644 test/passing/refs.janestreet/break_before_in.ml.ref create mode 100644 test/passing/refs.janestreet/break_cases-align.ml.err create mode 100644 test/passing/refs.janestreet/break_cases-align.ml.ref create mode 100644 test/passing/refs.janestreet/break_cases-all.ml.err create mode 100644 test/passing/refs.janestreet/break_cases-all.ml.ref create mode 100644 test/passing/refs.janestreet/break_cases-closing_on_separate_line.ml.err create mode 100644 test/passing/refs.janestreet/break_cases-closing_on_separate_line.ml.ref create mode 100644 test/passing/refs.janestreet/break_cases-closing_on_separate_line_fit_or_vertical.ml.err create mode 100644 test/passing/refs.janestreet/break_cases-closing_on_separate_line_fit_or_vertical.ml.ref create mode 100644 test/passing/refs.janestreet/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err create mode 100644 test/passing/refs.janestreet/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref create mode 100644 test/passing/refs.janestreet/break_cases-cosl_lnmp_cmei.ml.err create mode 100644 test/passing/refs.janestreet/break_cases-cosl_lnmp_cmei.ml.ref create mode 100644 test/passing/refs.janestreet/break_cases-fit_or_vertical.ml.err create mode 100644 test/passing/refs.janestreet/break_cases-fit_or_vertical.ml.ref create mode 100644 test/passing/refs.janestreet/break_cases-nested.ml.err create mode 100644 test/passing/refs.janestreet/break_cases-nested.ml.ref create mode 100644 test/passing/refs.janestreet/break_cases-normal_indent.ml.err create mode 100644 test/passing/refs.janestreet/break_cases-normal_indent.ml.ref create mode 100644 test/passing/refs.janestreet/break_cases-toplevel.ml.err create mode 100644 test/passing/refs.janestreet/break_cases-toplevel.ml.ref create mode 100644 test/passing/refs.janestreet/break_cases-vertical.ml.err create mode 100644 test/passing/refs.janestreet/break_cases-vertical.ml.ref create mode 100644 test/passing/refs.janestreet/break_cases.ml.err create mode 100644 test/passing/refs.janestreet/break_cases.ml.ref create mode 100644 test/passing/refs.janestreet/break_collection_expressions-wrap.ml.ref create mode 100644 test/passing/refs.janestreet/break_collection_expressions.ml.ref create mode 100644 test/passing/refs.janestreet/break_colon-before.ml.ref create mode 100644 test/passing/refs.janestreet/break_colon.ml.ref create mode 100644 test/passing/refs.janestreet/break_fun_decl-fit_or_vertical.ml.ref create mode 100644 test/passing/refs.janestreet/break_fun_decl-smart.ml.ref create mode 100644 test/passing/refs.janestreet/break_fun_decl-wrap.ml.ref create mode 100644 test/passing/refs.janestreet/break_fun_decl.ml.ref create mode 100644 test/passing/refs.janestreet/break_infix-fit-or-vertical.ml.ref create mode 100644 test/passing/refs.janestreet/break_infix-wrap.ml.ref create mode 100644 test/passing/refs.janestreet/break_infix.ml.ref create mode 100644 test/passing/refs.janestreet/break_record.ml.ref create mode 100644 test/passing/refs.janestreet/break_separators-after.ml.ref create mode 100644 test/passing/refs.janestreet/break_separators-after_docked.ml.ref create mode 100644 test/passing/refs.janestreet/break_separators-before_docked.ml.ref create mode 100644 test/passing/refs.janestreet/break_separators.ml.ref create mode 100644 test/passing/refs.janestreet/break_sequence_before.ml.ref create mode 100644 test/passing/refs.janestreet/break_string_literals-never.ml.err create mode 100644 test/passing/refs.janestreet/break_string_literals-never.ml.ref create mode 100644 test/passing/refs.janestreet/break_string_literals.ml.ref create mode 100644 test/passing/refs.janestreet/break_struct.ml.ref create mode 100644 test/passing/refs.janestreet/cases_exp_grouping.ml.ref create mode 100644 test/passing/refs.janestreet/cinaps.ml.ref create mode 100644 test/passing/refs.janestreet/class_expr.ml.ref create mode 100644 test/passing/refs.janestreet/class_sig-after.mli.ref create mode 100644 test/passing/refs.janestreet/class_sig.mli.ref create mode 100644 test/passing/refs.janestreet/class_type.ml.ref create mode 100644 test/passing/refs.janestreet/cmdline_override.ml.ref create mode 100644 test/passing/refs.janestreet/cmdline_override2.ml.ref create mode 100644 test/passing/refs.janestreet/coerce.ml.ref create mode 100644 test/passing/refs.janestreet/comment_breaking.ml.ref create mode 100644 test/passing/refs.janestreet/comment_header.ml.ref create mode 100644 test/passing/refs.janestreet/comment_in_empty.ml.ref create mode 100644 test/passing/refs.janestreet/comment_in_modules.ml.ref create mode 100644 test/passing/refs.janestreet/comment_last.ml.ref create mode 100644 test/passing/refs.janestreet/comment_sparse.ml.ref create mode 100644 test/passing/refs.janestreet/comments-no-wrap.ml.err create mode 100644 test/passing/refs.janestreet/comments-no-wrap.ml.ref create mode 100644 test/passing/refs.janestreet/comments.ml.err create mode 100644 test/passing/refs.janestreet/comments.ml.ref create mode 100644 test/passing/refs.janestreet/comments.mli.ref create mode 100644 test/passing/refs.janestreet/comments_args.ml.ref create mode 100644 test/passing/refs.janestreet/comments_around_disabled.ml.ref create mode 100644 test/passing/refs.janestreet/comments_in_local_let.ml.ref create mode 100644 test/passing/refs.janestreet/comments_in_record-break_separator-after.ml.err create mode 100644 test/passing/refs.janestreet/comments_in_record-break_separator-after.ml.ref create mode 100644 test/passing/refs.janestreet/comments_in_record-break_separator-before.ml.err create mode 100644 test/passing/refs.janestreet/comments_in_record-break_separator-before.ml.ref create mode 100644 test/passing/refs.janestreet/comments_in_record.ml.err create mode 100644 test/passing/refs.janestreet/comments_in_record.ml.ref create mode 100644 test/passing/refs.janestreet/crlf_to_crlf.ml.ref create mode 100644 test/passing/refs.janestreet/crlf_to_lf.ml.ref create mode 100644 test/passing/refs.janestreet/custom_list.ml.ref create mode 100644 test/passing/refs.janestreet/directives.mlt.ref create mode 100644 test/passing/refs.janestreet/disable_attr.ml.ref create mode 100644 test/passing/refs.janestreet/disable_class_type.ml.ref create mode 100644 test/passing/refs.janestreet/disable_conf_attrs.ml.err create mode 100644 test/passing/refs.janestreet/disable_conf_attrs.ml.ref create mode 100644 test/passing/refs.janestreet/disable_local_let.ml.ref create mode 100644 test/passing/refs.janestreet/disabled.ml.ref create mode 100644 test/passing/refs.janestreet/disabled_attr.ml.ref create mode 100644 test/passing/refs.janestreet/disambiguate.ml.ref create mode 100644 test/passing/refs.janestreet/disambiguated_types.ml.ref create mode 100644 test/passing/refs.janestreet/doc.mld.err create mode 100644 test/passing/refs.janestreet/doc.mld.ref create mode 100644 test/passing/refs.janestreet/doc_comments-after.ml.err create mode 100644 test/passing/refs.janestreet/doc_comments-after.ml.ref create mode 100644 test/passing/refs.janestreet/doc_comments-before-except-val.ml.err create mode 100644 test/passing/refs.janestreet/doc_comments-before-except-val.ml.ref create mode 100644 test/passing/refs.janestreet/doc_comments-before.ml.err create mode 100644 test/passing/refs.janestreet/doc_comments-before.ml.ref create mode 100644 test/passing/refs.janestreet/doc_comments-no-parse-docstrings.mli.err create mode 100644 test/passing/refs.janestreet/doc_comments-no-parse-docstrings.mli.ref create mode 100644 test/passing/refs.janestreet/doc_comments-no-wrap.mli.err create mode 100644 test/passing/refs.janestreet/doc_comments-no-wrap.mli.ref create mode 100644 test/passing/refs.janestreet/doc_comments.ml.err create mode 100644 test/passing/refs.janestreet/doc_comments.ml.ref create mode 100644 test/passing/refs.janestreet/doc_comments.mli.err create mode 100644 test/passing/refs.janestreet/doc_comments.mli.ref create mode 100644 test/passing/refs.janestreet/doc_comments_padding.ml.ref create mode 100644 test/passing/refs.janestreet/doc_repl.mld.ref create mode 100644 test/passing/refs.janestreet/docstrings_toplevel_directives.mlt.ref create mode 100644 test/passing/refs.janestreet/dune create mode 100644 test/passing/refs.janestreet/dune-project create mode 100644 test/passing/refs.janestreet/eliom_ext.eliom.err create mode 100644 test/passing/refs.janestreet/eliom_ext.eliom.ref create mode 100644 test/passing/refs.janestreet/empty_ml.ml.ref create mode 100644 test/passing/refs.janestreet/empty_mli.mli.ref create mode 100644 test/passing/refs.janestreet/empty_mlt.mlt.ref create mode 100644 test/passing/refs.janestreet/error1.ml.err create mode 100644 test/passing/refs.janestreet/error2.ml.err create mode 100644 test/passing/refs.janestreet/error3.ml.err create mode 100644 test/passing/refs.janestreet/error4.ml.err create mode 100644 test/passing/refs.janestreet/error4.ml.ref create mode 100644 test/passing/refs.janestreet/escaped_nl.ml.ref create mode 100644 test/passing/refs.janestreet/exceptions.ml.ref create mode 100644 test/passing/refs.janestreet/exceptions.mli.ref create mode 100644 test/passing/refs.janestreet/exp_grouping-parens.ml.ref create mode 100644 test/passing/refs.janestreet/exp_grouping.ml.ref create mode 100644 test/passing/refs.janestreet/exp_record.ml.ref create mode 100644 test/passing/refs.janestreet/expect_test.ml.err create mode 100644 test/passing/refs.janestreet/expect_test.ml.ref create mode 100644 test/passing/refs.janestreet/extensions-indent.ml.ref create mode 100644 test/passing/refs.janestreet/extensions-indent.mli.ref create mode 100644 test/passing/refs.janestreet/extensions.ml.ref create mode 100644 test/passing/refs.janestreet/extensions.mli.ref create mode 100644 test/passing/refs.janestreet/extensions_exp_grouping.ml.ref create mode 100644 test/passing/refs.janestreet/field-op_begin_line.ml.ref create mode 100644 test/passing/refs.janestreet/field.ml.ref create mode 100644 test/passing/refs.janestreet/first_class_module.ml.ref create mode 100644 test/passing/refs.janestreet/floating_doc.ml.ref create mode 100644 test/passing/refs.janestreet/for_while.ml.ref create mode 100644 test/passing/refs.janestreet/fun_decl-no-wrap-fun-args.ml.ref create mode 100644 test/passing/refs.janestreet/fun_decl.ml.ref create mode 100644 test/passing/refs.janestreet/fun_function.ml.ref create mode 100644 test/passing/refs.janestreet/function_indent-never.ml.ref create mode 100644 test/passing/refs.janestreet/function_indent.ml.ref create mode 100644 test/passing/refs.janestreet/functor.ml.ref create mode 100644 test/passing/refs.janestreet/functor.mli.ref create mode 100644 test/passing/refs.janestreet/funsig.ml.ref create mode 100644 test/passing/refs.janestreet/gadt.ml.ref create mode 100644 test/passing/refs.janestreet/generative.ml.ref create mode 100644 test/passing/refs.janestreet/hash_bang.ml.ref create mode 100644 test/passing/refs.janestreet/hash_types.ml.ref rename test/passing/{tests => refs.janestreet}/holes.ml.ref (100%) rename test/passing/{tests => refs.janestreet}/ifand.ml.ref (97%) create mode 100644 test/passing/refs.janestreet/index_op.ml.ref create mode 100644 test/passing/refs.janestreet/indicate_multiline_delimiters-cosl.ml.ref create mode 100644 test/passing/refs.janestreet/indicate_multiline_delimiters-space.ml.ref create mode 100644 test/passing/refs.janestreet/indicate_multiline_delimiters.ml.ref create mode 100644 test/passing/refs.janestreet/infix_arg_grouping.ml.ref create mode 100644 test/passing/refs.janestreet/infix_bind-break.ml.ref create mode 100644 test/passing/refs.janestreet/infix_bind-fit_or_vertical-break.ml.ref create mode 100644 test/passing/refs.janestreet/infix_bind-fit_or_vertical.ml.ref create mode 100644 test/passing/refs.janestreet/infix_bind.ml.ref create mode 100644 test/passing/refs.janestreet/infix_precedence.ml.ref create mode 100644 test/passing/refs.janestreet/injectivity.ml.ref create mode 100644 test/passing/refs.janestreet/into_infix.ml.ref create mode 100644 test/passing/refs.janestreet/invalid.ml.ref create mode 100644 test/passing/refs.janestreet/invalid_docstring.ml.ref create mode 100644 test/passing/refs.janestreet/invalid_docstrings.mli.ref create mode 100644 test/passing/refs.janestreet/issue114.ml.ref create mode 100644 test/passing/refs.janestreet/issue1750.ml.ref create mode 100644 test/passing/refs.janestreet/issue289.ml.ref create mode 100644 test/passing/refs.janestreet/issue48.ml.ref create mode 100644 test/passing/refs.janestreet/issue51.ml.ref create mode 100644 test/passing/refs.janestreet/issue57.ml.ref create mode 100644 test/passing/refs.janestreet/issue60.ml.ref create mode 100644 test/passing/refs.janestreet/issue77.ml.ref create mode 100644 test/passing/refs.janestreet/issue85.ml.ref create mode 100644 test/passing/refs.janestreet/issue89.ml.ref create mode 100644 test/passing/refs.janestreet/ite-compact.ml.err create mode 100644 test/passing/refs.janestreet/ite-compact.ml.ref create mode 100644 test/passing/refs.janestreet/ite-compact_closing.ml.err create mode 100644 test/passing/refs.janestreet/ite-compact_closing.ml.ref create mode 100644 test/passing/refs.janestreet/ite-fit_or_vertical.ml.ref create mode 100644 test/passing/refs.janestreet/ite-fit_or_vertical_closing.ml.ref create mode 100644 test/passing/refs.janestreet/ite-fit_or_vertical_no_indicate.ml.ref create mode 100644 test/passing/refs.janestreet/ite-kr.ml.ref create mode 100644 test/passing/refs.janestreet/ite-kr_closing.ml.ref create mode 100644 test/passing/refs.janestreet/ite-kw_first.ml.err create mode 100644 test/passing/refs.janestreet/ite-kw_first.ml.ref create mode 100644 test/passing/refs.janestreet/ite-kw_first_closing.ml.err create mode 100644 test/passing/refs.janestreet/ite-kw_first_closing.ml.ref create mode 100644 test/passing/refs.janestreet/ite-kw_first_no_indicate.ml.err create mode 100644 test/passing/refs.janestreet/ite-kw_first_no_indicate.ml.ref create mode 100644 test/passing/refs.janestreet/ite-no_indicate.ml.err create mode 100644 test/passing/refs.janestreet/ite-no_indicate.ml.ref create mode 100644 test/passing/refs.janestreet/ite-vertical.ml.ref create mode 100644 test/passing/refs.janestreet/ite.ml.err create mode 100644 test/passing/refs.janestreet/ite.ml.ref create mode 100644 test/passing/refs.janestreet/js_args.ml.ref create mode 100644 test/passing/refs.janestreet/js_begin.ml.ref create mode 100644 test/passing/refs.janestreet/js_bind.ml.ref create mode 100644 test/passing/refs.janestreet/js_fun.ml.ref create mode 100644 test/passing/refs.janestreet/js_map.ml.ref create mode 100644 test/passing/refs.janestreet/js_pattern.ml.ref create mode 100644 test/passing/refs.janestreet/js_poly.ml.ref rename test/passing/{tests => refs.janestreet}/js_record.ml.ref (100%) create mode 100644 test/passing/refs.janestreet/js_sig.mli.err rename test/passing/{tests => refs.janestreet}/js_sig.mli.ref (100%) create mode 100644 test/passing/refs.janestreet/js_source.ml.err create mode 100644 test/passing/refs.janestreet/js_source.ml.ref create mode 100644 test/passing/refs.janestreet/js_syntax.ml.ref create mode 100644 test/passing/refs.janestreet/js_to_do.ml.ref create mode 100644 test/passing/refs.janestreet/js_upon.ml.ref create mode 100644 test/passing/refs.janestreet/kw_extentions.ml.ref create mode 100644 test/passing/refs.janestreet/label_option_default_args.ml.ref create mode 100644 test/passing/refs.janestreet/labelled_args-414.ml.ref create mode 100644 test/passing/refs.janestreet/labelled_args.ml.ref create mode 100644 test/passing/refs.janestreet/lazy.ml.ref create mode 100644 test/passing/refs.janestreet/let_binding-deindent-fun.ml.ref create mode 100644 test/passing/refs.janestreet/let_binding-in_indent.ml.ref create mode 100644 test/passing/refs.janestreet/let_binding-indent.ml.ref create mode 100644 test/passing/refs.janestreet/let_binding.ml.ref create mode 100644 test/passing/refs.janestreet/let_binding_spacing-double-semicolon.ml.ref create mode 100644 test/passing/refs.janestreet/let_binding_spacing-sparse.ml.ref create mode 100644 test/passing/refs.janestreet/let_binding_spacing.ml.ref create mode 100644 test/passing/refs.janestreet/let_in_constr.ml.ref create mode 100644 test/passing/refs.janestreet/let_module-sparse.ml.ref create mode 100644 test/passing/refs.janestreet/let_module.ml.ref create mode 100644 test/passing/refs.janestreet/let_punning.ml.ref create mode 100644 test/passing/refs.janestreet/line_directives.ml.err create mode 100644 test/passing/refs.janestreet/list-space_around.ml.ref create mode 100644 test/passing/refs.janestreet/list.ml.ref create mode 100644 test/passing/refs.janestreet/list_and_comments.ml.ref create mode 100644 test/passing/refs.janestreet/list_normalized.ml.ref create mode 100644 test/passing/refs.janestreet/loc_stack.ml.ref create mode 100644 test/passing/refs.janestreet/locally_abtract_types.ml.ref create mode 100644 test/passing/refs.janestreet/margin_80.ml.ref create mode 100644 test/passing/refs.janestreet/match.ml.ref create mode 100644 test/passing/refs.janestreet/match2.ml.ref create mode 100644 test/passing/refs.janestreet/match_indent-never.ml.ref create mode 100644 test/passing/refs.janestreet/match_indent.ml.ref create mode 100644 test/passing/refs.janestreet/max_indent.ml.err create mode 100644 test/passing/refs.janestreet/max_indent.ml.ref create mode 100644 test/passing/refs.janestreet/mod_type_subst.ml.ref create mode 100644 test/passing/refs.janestreet/module.ml.ref create mode 100644 test/passing/refs.janestreet/module_anonymous.ml.ref create mode 100644 test/passing/refs.janestreet/module_attributes.ml.ref create mode 100644 test/passing/refs.janestreet/module_item_spacing-preserve.ml.ref create mode 100644 test/passing/refs.janestreet/module_item_spacing-sparse.ml.ref create mode 100644 test/passing/refs.janestreet/module_item_spacing.ml.ref create mode 100644 test/passing/refs.janestreet/module_item_spacing.mli.ref create mode 100644 test/passing/refs.janestreet/module_type.ml.err create mode 100644 test/passing/refs.janestreet/module_type.ml.ref create mode 100644 test/passing/refs.janestreet/module_type.mli.ref create mode 100644 test/passing/refs.janestreet/monadic_binding.ml.ref create mode 100644 test/passing/refs.janestreet/multi_index_op.ml.ref create mode 100644 test/passing/refs.janestreet/named_existentials.ml.ref create mode 100644 test/passing/refs.janestreet/need_format.ml.err create mode 100644 test/passing/refs.janestreet/new.ml.ref create mode 100644 test/passing/refs.janestreet/object.ml.ref create mode 100644 test/passing/refs.janestreet/object2.ml.ref create mode 100644 test/passing/refs.janestreet/object_expr-414.ml.ref create mode 100644 test/passing/refs.janestreet/object_expr.ml.ref create mode 100644 test/passing/refs.janestreet/object_type.ml.ref create mode 100644 test/passing/refs.janestreet/obuild.ml.ref create mode 100644 test/passing/refs.janestreet/ocp_indent_compat-break_colon_after.ml.ref create mode 100644 test/passing/refs.janestreet/ocp_indent_compat.ml.ref create mode 100644 test/passing/refs.janestreet/ocp_indent_options.ml.ref create mode 100644 test/passing/refs.janestreet/open-closing-on-separate-line.ml.ref create mode 100644 test/passing/refs.janestreet/open.ml.err create mode 100644 test/passing/refs.janestreet/open.ml.ref create mode 100644 test/passing/refs.janestreet/open_types.ml.ref create mode 100644 test/passing/refs.janestreet/option.ml.err create mode 100644 test/passing/refs.janestreet/option.ml.ref create mode 100644 test/passing/refs.janestreet/override.ml.ref create mode 100644 test/passing/refs.janestreet/parens_tuple_patterns.ml.ref create mode 100644 test/passing/refs.janestreet/polytypes.ml.err rename test/passing/{tests/polytypes-janestreet.ml.ref => refs.janestreet/polytypes.ml.ref} (100%) create mode 100644 test/passing/refs.janestreet/pre_post_extensions.ml.ref create mode 100644 test/passing/refs.janestreet/precedence.ml.ref create mode 100644 test/passing/refs.janestreet/prefix_infix.ml.ref create mode 100644 test/passing/refs.janestreet/profiles.ml.ref create mode 100644 test/passing/refs.janestreet/profiles2.ml.ref create mode 100644 test/passing/refs.janestreet/protected_object_types.ml.ref create mode 100644 test/passing/refs.janestreet/qtest.ml.err create mode 100644 test/passing/refs.janestreet/qtest.ml.ref create mode 100644 test/passing/refs.janestreet/quoted_strings.ml.ref create mode 100644 test/passing/refs.janestreet/recmod.mli.ref create mode 100644 test/passing/refs.janestreet/record-402.ml.err create mode 100644 test/passing/refs.janestreet/record-402.ml.ref create mode 100644 test/passing/refs.janestreet/record-loose.ml.err create mode 100644 test/passing/refs.janestreet/record-loose.ml.ref create mode 100644 test/passing/refs.janestreet/record-tight_decl.ml.err create mode 100644 test/passing/refs.janestreet/record-tight_decl.ml.ref create mode 100644 test/passing/refs.janestreet/record.ml.err create mode 100644 test/passing/refs.janestreet/record.ml.ref rename test/passing/{tests/record_punning-js.ml.ref => refs.janestreet/record_punning.ml.ref} (100%) create mode 100644 test/passing/refs.janestreet/reformat_string.ml.ref create mode 100644 test/passing/refs.janestreet/refs.ml.ref create mode 100644 test/passing/refs.janestreet/remove_extra_parens.ml.ref create mode 100644 test/passing/refs.janestreet/repl.ml.ref create mode 100644 test/passing/refs.janestreet/repl.mli.ref create mode 100644 test/passing/refs.janestreet/revapply_ext.ml.ref create mode 100644 test/passing/refs.janestreet/send.ml.ref create mode 100644 test/passing/refs.janestreet/sequence-preserve.ml.ref create mode 100644 test/passing/refs.janestreet/sequence.ml.ref create mode 100644 test/passing/refs.janestreet/shebang.ml.ref create mode 100644 test/passing/refs.janestreet/shortcut_ext_attr.ml.ref create mode 100644 test/passing/refs.janestreet/sig_value.mli.err create mode 100644 test/passing/refs.janestreet/sig_value.mli.ref create mode 100644 test/passing/refs.janestreet/single_line.mli.ref create mode 100644 test/passing/refs.janestreet/skip.ml.ref rename test/passing/{tests/js_source.ml.ref => refs.janestreet/source.ml.ref} (89%) create mode 100644 test/passing/refs.janestreet/str_value.ml.ref create mode 100644 test/passing/refs.janestreet/string.ml.ref create mode 100644 test/passing/refs.janestreet/string_array.ml.ref create mode 100644 test/passing/refs.janestreet/string_wrapping.ml.ref create mode 100644 test/passing/refs.janestreet/symbol.ml.ref create mode 100644 test/passing/refs.janestreet/tag_only.ml.ref create mode 100644 test/passing/refs.janestreet/tag_only.mli.ref create mode 100644 test/passing/refs.janestreet/try_with_or_pattern.ml.ref create mode 100644 test/passing/refs.janestreet/tuple.ml.ref create mode 100644 test/passing/refs.janestreet/tuple_less_parens.ml.ref create mode 100644 test/passing/refs.janestreet/tuple_type_parens.ml.ref create mode 100644 test/passing/refs.janestreet/type_and_constraint.ml.ref create mode 100644 test/passing/refs.janestreet/type_annotations.ml.ref create mode 100644 test/passing/refs.janestreet/types-compact-space_around-docked.ml.err create mode 100644 test/passing/refs.janestreet/types-compact-space_around-docked.ml.ref create mode 100644 test/passing/refs.janestreet/types-compact-space_around.ml.err create mode 100644 test/passing/refs.janestreet/types-compact-space_around.ml.ref create mode 100644 test/passing/refs.janestreet/types-compact.ml.err create mode 100644 test/passing/refs.janestreet/types-compact.ml.ref create mode 100644 test/passing/refs.janestreet/types-indent.ml.ref create mode 100644 test/passing/refs.janestreet/types-sparse-space_around.ml.ref create mode 100644 test/passing/refs.janestreet/types-sparse.ml.ref create mode 100644 test/passing/refs.janestreet/types.ml.ref create mode 100644 test/passing/refs.janestreet/unary.ml.ref create mode 100644 test/passing/refs.janestreet/unary_hash.ml.ref create mode 100644 test/passing/refs.janestreet/unicode.ml.err create mode 100644 test/passing/refs.janestreet/unicode.ml.ref create mode 100644 test/passing/refs.janestreet/use_file.mlt.ref create mode 100644 test/passing/refs.janestreet/variants.ml.ref create mode 100644 test/passing/refs.janestreet/verbatim_comments-wrap.ml.ref create mode 100644 test/passing/refs.janestreet/verbatim_comments.ml.ref create mode 100644 test/passing/refs.janestreet/w50.ml.ref create mode 100644 test/passing/refs.janestreet/wrap_comments.ml.err create mode 100644 test/passing/refs.janestreet/wrap_comments.ml.ref create mode 100644 test/passing/refs.janestreet/wrap_comments_break.ml.ref create mode 100644 test/passing/refs.janestreet/wrap_invalid_doc_comments.ml.err create mode 100644 test/passing/refs.janestreet/wrap_invalid_doc_comments.ml.ref create mode 100644 test/passing/refs.janestreet/wrapping_functor_args.ml.ref create mode 100644 test/passing/refs.ocamlformat/.ocamlformat create mode 100644 test/passing/refs.ocamlformat/align_infix.ml.ref create mode 100644 test/passing/refs.ocamlformat/alignment.ml.err create mode 100644 test/passing/refs.ocamlformat/alignment.ml.ref create mode 100644 test/passing/refs.ocamlformat/apply.ml.ref create mode 100644 test/passing/refs.ocamlformat/apply_functor.ml.ref create mode 100644 test/passing/refs.ocamlformat/args_grouped.ml.ref create mode 100644 test/passing/refs.ocamlformat/array.ml.ref create mode 100644 test/passing/refs.ocamlformat/assignment_operator-op_begin_line.ml.err rename test/passing/{tests => refs.ocamlformat}/assignment_operator-op_begin_line.ml.ref (92%) create mode 100644 test/passing/refs.ocamlformat/assignment_operator.ml.err rename test/passing/{tests => refs.ocamlformat}/assignment_operator.ml.ref (86%) create mode 100644 test/passing/refs.ocamlformat/attribute_and_expression.ml.ref create mode 100644 test/passing/refs.ocamlformat/attributes.ml.err create mode 100644 test/passing/refs.ocamlformat/attributes.ml.ref create mode 100644 test/passing/refs.ocamlformat/attributes.mli.ref create mode 100644 test/passing/refs.ocamlformat/binders.ml.ref create mode 100644 test/passing/refs.ocamlformat/break_before_in-auto.ml.err create mode 100644 test/passing/refs.ocamlformat/break_before_in-auto.ml.ref create mode 100644 test/passing/refs.ocamlformat/break_before_in.ml.ref create mode 100644 test/passing/refs.ocamlformat/break_cases-align.ml.err rename test/passing/{tests => refs.ocamlformat}/break_cases-align.ml.ref (96%) create mode 100644 test/passing/refs.ocamlformat/break_cases-all.ml.err rename test/passing/{tests => refs.ocamlformat}/break_cases-all.ml.ref (96%) create mode 100644 test/passing/refs.ocamlformat/break_cases-closing_on_separate_line.ml.err rename test/passing/{tests => refs.ocamlformat}/break_cases-closing_on_separate_line.ml.ref (96%) create mode 100644 test/passing/refs.ocamlformat/break_cases-closing_on_separate_line_fit_or_vertical.ml.err rename test/passing/{tests => refs.ocamlformat}/break_cases-closing_on_separate_line_fit_or_vertical.ml.ref (94%) create mode 100644 test/passing/refs.ocamlformat/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err rename test/passing/{tests => refs.ocamlformat}/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref (96%) create mode 100644 test/passing/refs.ocamlformat/break_cases-cosl_lnmp_cmei.ml.err rename test/passing/{tests => refs.ocamlformat}/break_cases-cosl_lnmp_cmei.ml.ref (96%) create mode 100644 test/passing/refs.ocamlformat/break_cases-fit_or_vertical.ml.err rename test/passing/{tests => refs.ocamlformat}/break_cases-fit_or_vertical.ml.ref (93%) create mode 100644 test/passing/refs.ocamlformat/break_cases-nested.ml.err rename test/passing/{tests => refs.ocamlformat}/break_cases-nested.ml.ref (95%) create mode 100644 test/passing/refs.ocamlformat/break_cases-normal_indent.ml.err rename test/passing/{tests => refs.ocamlformat}/break_cases-normal_indent.ml.ref (96%) create mode 100644 test/passing/refs.ocamlformat/break_cases-toplevel.ml.err rename test/passing/{tests => refs.ocamlformat}/break_cases-toplevel.ml.ref (93%) create mode 100644 test/passing/refs.ocamlformat/break_cases-vertical.ml.err rename test/passing/{tests => refs.ocamlformat}/break_cases-vertical.ml.ref (96%) create mode 100644 test/passing/refs.ocamlformat/break_cases.ml.err rename test/passing/{tests => refs.ocamlformat}/break_cases.ml.ref (93%) create mode 100644 test/passing/refs.ocamlformat/break_collection_expressions-wrap.ml.err rename test/passing/{tests => refs.ocamlformat}/break_collection_expressions-wrap.ml.ref (68%) create mode 100644 test/passing/refs.ocamlformat/break_collection_expressions.ml.err rename test/passing/{tests => refs.ocamlformat}/break_collection_expressions.ml.ref (96%) rename test/passing/{tests => refs.ocamlformat}/break_colon-before.ml.ref (94%) create mode 100644 test/passing/refs.ocamlformat/break_colon.ml.ref rename test/passing/{tests => refs.ocamlformat}/break_fun_decl-fit_or_vertical.ml.ref (96%) rename test/passing/{tests => refs.ocamlformat}/break_fun_decl-smart.ml.ref (96%) rename test/passing/{tests => refs.ocamlformat}/break_fun_decl-wrap.ml.ref (96%) create mode 100644 test/passing/refs.ocamlformat/break_fun_decl.ml.ref create mode 100644 test/passing/refs.ocamlformat/break_infix-fit-or-vertical.ml.err rename test/passing/{tests => refs.ocamlformat}/break_infix-fit-or-vertical.ml.ref (96%) create mode 100644 test/passing/refs.ocamlformat/break_infix-wrap.ml.err rename test/passing/{tests => refs.ocamlformat}/break_infix-wrap.ml.ref (95%) create mode 100644 test/passing/refs.ocamlformat/break_infix.ml.err rename test/passing/{tests => refs.ocamlformat}/break_infix.ml.ref (96%) create mode 100644 test/passing/refs.ocamlformat/break_record.ml.ref create mode 100644 test/passing/refs.ocamlformat/break_separators-after.ml.err rename test/passing/{tests => refs.ocamlformat}/break_separators-after.ml.ref (95%) create mode 100644 test/passing/refs.ocamlformat/break_separators-after_docked.ml.err rename test/passing/{tests => refs.ocamlformat}/break_separators-after_docked.ml.ref (94%) create mode 100644 test/passing/refs.ocamlformat/break_separators-before_docked.ml.err rename test/passing/{tests => refs.ocamlformat}/break_separators-before_docked.ml.ref (95%) create mode 100644 test/passing/refs.ocamlformat/break_separators.ml.err create mode 100644 test/passing/refs.ocamlformat/break_separators.ml.ref create mode 100644 test/passing/refs.ocamlformat/break_sequence_before.ml.ref create mode 100644 test/passing/refs.ocamlformat/break_string_literals-never.ml.err rename test/passing/{tests => refs.ocamlformat}/break_string_literals-never.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/break_string_literals.ml.ref (89%) rename test/passing/{tests => refs.ocamlformat}/break_struct.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/cases_exp_grouping.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/cinaps.ml.ref (97%) create mode 100644 test/passing/refs.ocamlformat/class_expr.ml.ref rename test/passing/{tests => refs.ocamlformat}/class_sig-after.mli.ref (100%) rename test/passing/{tests => refs.ocamlformat}/class_sig.mli.ref (100%) rename test/passing/{tests => refs.ocamlformat}/class_type.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/cmdline_override.ml.ref create mode 100644 test/passing/refs.ocamlformat/cmdline_override2.ml.ref create mode 100644 test/passing/refs.ocamlformat/coerce.ml.ref create mode 100644 test/passing/refs.ocamlformat/comment_breaking.ml.ref create mode 100644 test/passing/refs.ocamlformat/comment_header.ml.ref create mode 100644 test/passing/refs.ocamlformat/comment_in_empty.ml.ref rename test/passing/{tests => refs.ocamlformat}/comment_in_modules.ml.ref (89%) create mode 100644 test/passing/refs.ocamlformat/comment_last.ml.ref create mode 100644 test/passing/refs.ocamlformat/comment_sparse.ml.ref create mode 100644 test/passing/refs.ocamlformat/comments-no-wrap.ml.err rename test/passing/{tests => refs.ocamlformat}/comments-no-wrap.ml.ref (90%) create mode 100644 test/passing/refs.ocamlformat/comments.ml.err rename test/passing/{tests => refs.ocamlformat}/comments.ml.ref (87%) create mode 100644 test/passing/refs.ocamlformat/comments.mli.ref create mode 100644 test/passing/refs.ocamlformat/comments_args.ml.ref create mode 100644 test/passing/refs.ocamlformat/comments_around_disabled.ml.ref create mode 100644 test/passing/refs.ocamlformat/comments_in_local_let.ml.ref create mode 100644 test/passing/refs.ocamlformat/comments_in_record-break_separator-after.ml.err rename test/passing/{tests => refs.ocamlformat}/comments_in_record-break_separator-after.ml.ref (88%) create mode 100644 test/passing/refs.ocamlformat/comments_in_record-break_separator-before.ml.err rename test/passing/{tests => refs.ocamlformat}/comments_in_record-break_separator-before.ml.ref (88%) create mode 100644 test/passing/refs.ocamlformat/comments_in_record.ml.err rename test/passing/{tests => refs.ocamlformat}/comments_in_record.ml.ref (88%) rename test/passing/{tests => refs.ocamlformat}/crlf_to_crlf.ml.ref (80%) rename test/passing/{tests => refs.ocamlformat}/crlf_to_lf.ml.ref (86%) create mode 100644 test/passing/refs.ocamlformat/custom_list.ml.ref create mode 100644 test/passing/refs.ocamlformat/directives.mlt.ref create mode 100644 test/passing/refs.ocamlformat/disable_attr.ml.ref create mode 100644 test/passing/refs.ocamlformat/disable_class_type.ml.ref create mode 100644 test/passing/refs.ocamlformat/disable_conf_attrs.ml.err rename test/passing/{tests => refs.ocamlformat}/disable_conf_attrs.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/disable_local_let.ml.ref create mode 100644 test/passing/refs.ocamlformat/disabled.ml.ref create mode 100644 test/passing/refs.ocamlformat/disabled_attr.ml.ref create mode 100644 test/passing/refs.ocamlformat/disambiguate.ml.ref create mode 100644 test/passing/refs.ocamlformat/disambiguated_types.ml.ref create mode 100644 test/passing/refs.ocamlformat/doc.mld.ref create mode 100644 test/passing/refs.ocamlformat/doc_comments-after.ml.err create mode 100644 test/passing/refs.ocamlformat/doc_comments-after.ml.ref create mode 100644 test/passing/refs.ocamlformat/doc_comments-before-except-val.ml.err create mode 100644 test/passing/refs.ocamlformat/doc_comments-before-except-val.ml.ref create mode 100644 test/passing/refs.ocamlformat/doc_comments-before.ml.err create mode 100644 test/passing/refs.ocamlformat/doc_comments-before.ml.ref create mode 100644 test/passing/refs.ocamlformat/doc_comments-no-parse-docstrings.mli.err rename test/passing/{tests => refs.ocamlformat}/doc_comments-no-parse-docstrings.mli.ref (100%) create mode 100644 test/passing/refs.ocamlformat/doc_comments-no-wrap.mli.err create mode 100644 test/passing/refs.ocamlformat/doc_comments-no-wrap.mli.ref create mode 100644 test/passing/refs.ocamlformat/doc_comments.ml.err create mode 100644 test/passing/refs.ocamlformat/doc_comments.ml.ref create mode 100644 test/passing/refs.ocamlformat/doc_comments.mli.err create mode 100644 test/passing/refs.ocamlformat/doc_comments.mli.ref create mode 100644 test/passing/refs.ocamlformat/doc_comments_padding.ml.ref rename test/passing/{tests => refs.ocamlformat}/doc_repl.mld.ref (100%) create mode 100644 test/passing/refs.ocamlformat/docstrings_toplevel_directives.mlt.ref create mode 100644 test/passing/refs.ocamlformat/dune create mode 100644 test/passing/refs.ocamlformat/dune-project create mode 100644 test/passing/refs.ocamlformat/eliom_ext.eliom.err create mode 100644 test/passing/refs.ocamlformat/eliom_ext.eliom.ref create mode 100644 test/passing/refs.ocamlformat/empty_ml.ml.ref create mode 100644 test/passing/refs.ocamlformat/empty_mli.mli.ref create mode 100644 test/passing/refs.ocamlformat/empty_mlt.mlt.ref create mode 100644 test/passing/refs.ocamlformat/error1.ml.err create mode 100644 test/passing/refs.ocamlformat/error2.ml.err create mode 100644 test/passing/refs.ocamlformat/error3.ml.err create mode 100644 test/passing/refs.ocamlformat/error4.ml.err create mode 100644 test/passing/refs.ocamlformat/error4.ml.ref rename test/passing/{tests => refs.ocamlformat}/escaped_nl.ml.ref (79%) create mode 100644 test/passing/refs.ocamlformat/exceptions.ml.ref create mode 100644 test/passing/refs.ocamlformat/exceptions.mli.ref rename test/passing/{tests => refs.ocamlformat}/exp_grouping-parens.ml.ref (92%) rename test/passing/{tests => refs.ocamlformat}/exp_grouping.ml.ref (92%) create mode 100644 test/passing/refs.ocamlformat/exp_record.ml.ref create mode 100644 test/passing/refs.ocamlformat/expect_test.ml.err create mode 100644 test/passing/refs.ocamlformat/expect_test.ml.ref rename test/passing/{tests => refs.ocamlformat}/extensions-indent.ml.ref (98%) rename test/passing/{tests => refs.ocamlformat}/extensions-indent.mli.ref (100%) rename test/passing/{tests => refs.ocamlformat}/extensions.ml.ref (98%) create mode 100644 test/passing/refs.ocamlformat/extensions.mli.ref create mode 100644 test/passing/refs.ocamlformat/extensions_exp_grouping.ml.ref rename test/passing/{tests => refs.ocamlformat}/field-op_begin_line.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/field.ml.ref rename test/passing/{tests => refs.ocamlformat}/first_class_module.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/floating_doc.ml.ref create mode 100644 test/passing/refs.ocamlformat/for_while.ml.ref rename test/passing/{tests => refs.ocamlformat}/fun_decl-no-wrap-fun-args.ml.ref (82%) rename test/passing/{tests => refs.ocamlformat}/fun_decl.ml.ref (82%) create mode 100644 test/passing/refs.ocamlformat/fun_function.ml.ref create mode 100644 test/passing/refs.ocamlformat/function_indent-never.ml.ref create mode 100644 test/passing/refs.ocamlformat/function_indent.ml.ref create mode 100644 test/passing/refs.ocamlformat/functor.ml.err rename test/passing/{tests => refs.ocamlformat}/functor.ml.ref (92%) create mode 100644 test/passing/refs.ocamlformat/functor.mli.ref create mode 100644 test/passing/refs.ocamlformat/funsig.ml.ref create mode 100644 test/passing/refs.ocamlformat/gadt.ml.ref rename test/passing/{tests => refs.ocamlformat}/generative.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/hash_bang.ml.ref create mode 100644 test/passing/refs.ocamlformat/hash_types.ml.ref create mode 100644 test/passing/refs.ocamlformat/holes.ml.ref create mode 100644 test/passing/refs.ocamlformat/ifand.ml.ref create mode 100644 test/passing/refs.ocamlformat/index_op.ml.ref rename test/passing/{tests => refs.ocamlformat}/indicate_multiline_delimiters-cosl.ml.ref (72%) rename test/passing/{tests => refs.ocamlformat}/indicate_multiline_delimiters-space.ml.ref (71%) create mode 100644 test/passing/refs.ocamlformat/indicate_multiline_delimiters.ml.ref rename test/passing/{tests => refs.ocamlformat}/infix_arg_grouping.ml.ref (89%) rename test/passing/{tests => refs.ocamlformat}/infix_bind-break.ml.ref (91%) rename test/passing/{tests => refs.ocamlformat}/infix_bind-fit_or_vertical-break.ml.ref (93%) rename test/passing/{tests => refs.ocamlformat}/infix_bind-fit_or_vertical.ml.ref (87%) create mode 100644 test/passing/refs.ocamlformat/infix_bind.ml.ref create mode 100644 test/passing/refs.ocamlformat/infix_precedence.ml.ref create mode 100644 test/passing/refs.ocamlformat/injectivity.ml.ref create mode 100644 test/passing/refs.ocamlformat/into_infix.ml.ref create mode 100644 test/passing/refs.ocamlformat/invalid.ml.ref create mode 100644 test/passing/refs.ocamlformat/invalid_docstring.ml.ref create mode 100644 test/passing/refs.ocamlformat/invalid_docstrings.mli.ref create mode 100644 test/passing/refs.ocamlformat/issue114.ml.ref create mode 100644 test/passing/refs.ocamlformat/issue1750.ml.err create mode 100644 test/passing/refs.ocamlformat/issue1750.ml.ref create mode 100644 test/passing/refs.ocamlformat/issue289.ml.ref create mode 100644 test/passing/refs.ocamlformat/issue48.ml.ref create mode 100644 test/passing/refs.ocamlformat/issue51.ml.ref create mode 100644 test/passing/refs.ocamlformat/issue57.ml.ref create mode 100644 test/passing/refs.ocamlformat/issue60.ml.ref create mode 100644 test/passing/refs.ocamlformat/issue77.ml.ref create mode 100644 test/passing/refs.ocamlformat/issue85.ml.ref create mode 100644 test/passing/refs.ocamlformat/issue89.ml.ref rename test/passing/{tests => refs.ocamlformat}/ite-compact.ml.ref (96%) rename test/passing/{tests => refs.ocamlformat}/ite-compact_closing.ml.ref (94%) rename test/passing/{tests => refs.ocamlformat}/ite-fit_or_vertical.ml.ref (96%) rename test/passing/{tests => refs.ocamlformat}/ite-fit_or_vertical_closing.ml.ref (95%) create mode 100644 test/passing/refs.ocamlformat/ite-fit_or_vertical_no_indicate.ml.err rename test/passing/{tests => refs.ocamlformat}/ite-fit_or_vertical_no_indicate.ml.ref (95%) rename test/passing/{tests => refs.ocamlformat}/ite-kr.ml.ref (97%) rename test/passing/{tests => refs.ocamlformat}/ite-kr_closing.ml.ref (95%) rename test/passing/{tests => refs.ocamlformat}/ite-kw_first.ml.ref (97%) rename test/passing/{tests => refs.ocamlformat}/ite-kw_first_closing.ml.ref (95%) create mode 100644 test/passing/refs.ocamlformat/ite-kw_first_no_indicate.ml.err rename test/passing/{tests => refs.ocamlformat}/ite-kw_first_no_indicate.ml.ref (96%) create mode 100644 test/passing/refs.ocamlformat/ite-no_indicate.ml.err rename test/passing/{tests => refs.ocamlformat}/ite-no_indicate.ml.ref (94%) rename test/passing/{tests => refs.ocamlformat}/ite-vertical.ml.ref (97%) rename test/passing/{tests => refs.ocamlformat}/ite.ml.ref (96%) rename test/passing/{tests => refs.ocamlformat}/js_args.ml.ref (86%) rename test/passing/{tests => refs.ocamlformat}/js_begin.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/js_bind.ml.err rename test/passing/{tests => refs.ocamlformat}/js_bind.ml.ref (57%) rename test/passing/{tests => refs.ocamlformat}/js_fun.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/js_map.ml.ref rename test/passing/{tests => refs.ocamlformat}/js_pattern.ml.ref (88%) rename test/passing/{tests => refs.ocamlformat}/js_poly.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/js_record.ml.ref create mode 100644 test/passing/refs.ocamlformat/js_sig.mli.ref create mode 100644 test/passing/refs.ocamlformat/js_source.ml.err create mode 100644 test/passing/refs.ocamlformat/js_source.ml.ref rename test/passing/{tests => refs.ocamlformat}/js_syntax.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/js_to_do.ml.ref (59%) rename test/passing/{tests => refs.ocamlformat}/js_upon.ml.ref (78%) create mode 100644 test/passing/refs.ocamlformat/kw_extentions.ml.ref rename test/passing/{tests => refs.ocamlformat}/label_option_default_args.ml.ref (98%) rename test/passing/{tests => refs.ocamlformat}/labelled_args-414.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/labelled_args.ml.ref create mode 100644 test/passing/refs.ocamlformat/lazy.ml.ref rename test/passing/{tests => refs.ocamlformat}/let_binding-deindent-fun.ml.ref (88%) rename test/passing/{tests => refs.ocamlformat}/let_binding-in_indent.ml.ref (89%) rename test/passing/{tests => refs.ocamlformat}/let_binding-indent.ml.ref (87%) rename test/passing/{tests => refs.ocamlformat}/let_binding.ml.ref (88%) rename test/passing/{tests => refs.ocamlformat}/let_binding_spacing-double-semicolon.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/let_binding_spacing-sparse.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/let_binding_spacing.ml.ref create mode 100644 test/passing/refs.ocamlformat/let_in_constr.ml.ref rename test/passing/{tests => refs.ocamlformat}/let_module-sparse.ml.ref (97%) rename test/passing/{tests => refs.ocamlformat}/let_module.ml.ref (97%) create mode 100644 test/passing/refs.ocamlformat/let_punning.ml.ref create mode 100644 test/passing/refs.ocamlformat/line_directives.ml.err rename test/passing/{tests => refs.ocamlformat}/list-space_around.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/list.ml.ref rename test/passing/{tests => refs.ocamlformat}/list_and_comments.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/list_normalized.ml.ref (90%) rename test/passing/{tests => refs.ocamlformat}/loc_stack.ml.ref (62%) create mode 100644 test/passing/refs.ocamlformat/locally_abtract_types.ml.ref create mode 100644 test/passing/refs.ocamlformat/margin_80.ml.err rename test/passing/{tests => refs.ocamlformat}/margin_80.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/match.ml.ref create mode 100644 test/passing/refs.ocamlformat/match2.ml.ref create mode 100644 test/passing/refs.ocamlformat/match_indent-never.ml.ref create mode 100644 test/passing/refs.ocamlformat/match_indent.ml.ref create mode 100644 test/passing/refs.ocamlformat/max_indent.ml.ref create mode 100644 test/passing/refs.ocamlformat/mod_type_subst.ml.ref create mode 100644 test/passing/refs.ocamlformat/module.ml.ref create mode 100644 test/passing/refs.ocamlformat/module_anonymous.ml.ref rename test/passing/{tests => refs.ocamlformat}/module_attributes.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/module_item_spacing-preserve.ml.ref (95%) rename test/passing/{tests => refs.ocamlformat}/module_item_spacing-sparse.ml.ref (95%) rename test/passing/{tests => refs.ocamlformat}/module_item_spacing.ml.ref (95%) rename test/passing/{tests => refs.ocamlformat}/module_item_spacing.mli.ref (100%) create mode 100644 test/passing/refs.ocamlformat/module_type.ml.err create mode 100644 test/passing/refs.ocamlformat/module_type.ml.ref create mode 100644 test/passing/refs.ocamlformat/module_type.mli.err create mode 100644 test/passing/refs.ocamlformat/module_type.mli.ref create mode 100644 test/passing/refs.ocamlformat/monadic_binding.ml.ref create mode 100644 test/passing/refs.ocamlformat/multi_index_op.ml.ref create mode 100644 test/passing/refs.ocamlformat/named_existentials.ml.ref create mode 100644 test/passing/refs.ocamlformat/need_format.ml.err create mode 100644 test/passing/refs.ocamlformat/new.ml.ref rename test/passing/{tests => refs.ocamlformat}/object.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/object2.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/object_expr-414.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/object_expr.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/object_type.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/obuild.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/ocp_indent_compat-break_colon_after.ml.ref (96%) create mode 100644 test/passing/refs.ocamlformat/ocp_indent_compat.ml.ref rename test/passing/{tests => refs.ocamlformat}/ocp_indent_options.ml.ref (86%) rename test/passing/{tests => refs.ocamlformat}/open-closing-on-separate-line.ml.ref (99%) rename test/passing/{tests => refs.ocamlformat}/open.ml.ref (98%) create mode 100644 test/passing/refs.ocamlformat/open_types.ml.ref create mode 100644 test/passing/refs.ocamlformat/option.ml.err rename test/passing/{tests => refs.ocamlformat}/option.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/override.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/parens_tuple_patterns.ml.ref create mode 100644 test/passing/refs.ocamlformat/polytypes.ml.ref create mode 100644 test/passing/refs.ocamlformat/pre_post_extensions.ml.ref create mode 100644 test/passing/refs.ocamlformat/precedence.ml.ref create mode 100644 test/passing/refs.ocamlformat/prefix_infix.ml.ref create mode 100644 test/passing/refs.ocamlformat/profiles.ml.ref create mode 100644 test/passing/refs.ocamlformat/profiles2.ml.ref create mode 100644 test/passing/refs.ocamlformat/protected_object_types.ml.ref create mode 100644 test/passing/refs.ocamlformat/qtest.ml.err create mode 100644 test/passing/refs.ocamlformat/qtest.ml.ref create mode 100644 test/passing/refs.ocamlformat/quoted_strings.ml.ref create mode 100644 test/passing/refs.ocamlformat/recmod.mli.ref create mode 100644 test/passing/refs.ocamlformat/record-402.ml.err rename test/passing/{tests => refs.ocamlformat}/record-402.ml.ref (98%) create mode 100644 test/passing/refs.ocamlformat/record-loose.ml.err rename test/passing/{tests => refs.ocamlformat}/record-loose.ml.ref (98%) create mode 100644 test/passing/refs.ocamlformat/record-tight_decl.ml.err rename test/passing/{tests => refs.ocamlformat}/record-tight_decl.ml.ref (98%) create mode 100644 test/passing/refs.ocamlformat/record.ml.err rename test/passing/{tests => refs.ocamlformat}/record.ml.ref (98%) rename test/passing/{tests => refs.ocamlformat}/record_punning.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/reformat_string.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/refs.ml.err create mode 100644 test/passing/refs.ocamlformat/refs.ml.ref rename test/passing/{tests => refs.ocamlformat}/remove_extra_parens.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/repl.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/repl.mli.ref create mode 100644 test/passing/refs.ocamlformat/revapply_ext.ml.ref create mode 100644 test/passing/refs.ocamlformat/send.ml.ref rename test/passing/{tests => refs.ocamlformat}/sequence-preserve.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/sequence.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/shebang.ml.ref create mode 100644 test/passing/refs.ocamlformat/shortcut_ext_attr.ml.ref create mode 100644 test/passing/refs.ocamlformat/sig_value.mli.err rename test/passing/{tests => refs.ocamlformat}/sig_value.mli.ref (83%) create mode 100644 test/passing/refs.ocamlformat/single_line.mli.ref create mode 100644 test/passing/refs.ocamlformat/skip.ml.ref create mode 100644 test/passing/refs.ocamlformat/source.ml.err rename test/passing/{tests => refs.ocamlformat}/source.ml.ref (85%) create mode 100644 test/passing/refs.ocamlformat/str_value.ml.ref rename test/passing/{tests => refs.ocamlformat}/string.ml.ref (92%) create mode 100644 test/passing/refs.ocamlformat/string_array.ml.ref create mode 100644 test/passing/refs.ocamlformat/string_wrapping.ml.ref create mode 100644 test/passing/refs.ocamlformat/symbol.ml.ref create mode 100644 test/passing/refs.ocamlformat/tag_only.ml.ref create mode 100644 test/passing/refs.ocamlformat/tag_only.mli.ref create mode 100644 test/passing/refs.ocamlformat/try_with_or_pattern.ml.ref create mode 100644 test/passing/refs.ocamlformat/tuple.ml.ref create mode 100644 test/passing/refs.ocamlformat/tuple_less_parens.ml.ref create mode 100644 test/passing/refs.ocamlformat/tuple_type_parens.ml.ref create mode 100644 test/passing/refs.ocamlformat/type_and_constraint.ml.ref create mode 100644 test/passing/refs.ocamlformat/type_annotations.ml.ref rename test/passing/{tests => refs.ocamlformat}/types-compact-space_around-docked.ml.ref (95%) rename test/passing/{tests => refs.ocamlformat}/types-compact-space_around.ml.ref (95%) rename test/passing/{tests => refs.ocamlformat}/types-compact.ml.ref (95%) rename test/passing/{tests => refs.ocamlformat}/types-indent.ml.ref (94%) rename test/passing/{tests => refs.ocamlformat}/types-sparse-space_around.ml.ref (100%) rename test/passing/{tests => refs.ocamlformat}/types-sparse.ml.ref (95%) create mode 100644 test/passing/refs.ocamlformat/types.ml.ref rename test/passing/{tests => refs.ocamlformat}/unary.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/unary_hash.ml.ref create mode 100644 test/passing/refs.ocamlformat/unicode.ml.err create mode 100644 test/passing/refs.ocamlformat/unicode.ml.ref create mode 100644 test/passing/refs.ocamlformat/use_file.mlt.ref create mode 100644 test/passing/refs.ocamlformat/variants.ml.ref create mode 100644 test/passing/refs.ocamlformat/verbatim_comments-wrap.ml.ref create mode 100644 test/passing/refs.ocamlformat/verbatim_comments.ml.ref create mode 100644 test/passing/refs.ocamlformat/w50.ml.ref create mode 100644 test/passing/refs.ocamlformat/wrap_comments.ml.err rename test/passing/{tests => refs.ocamlformat}/wrap_comments.ml.ref (100%) create mode 100644 test/passing/refs.ocamlformat/wrap_comments_break.ml.ref create mode 100644 test/passing/refs.ocamlformat/wrap_invalid_doc_comments.ml.err create mode 100644 test/passing/refs.ocamlformat/wrap_invalid_doc_comments.ml.ref create mode 100644 test/passing/refs.ocamlformat/wrapping_functor_args.ml.err create mode 100644 test/passing/refs.ocamlformat/wrapping_functor_args.ml.ref delete mode 100644 test/passing/tests/.ocamlformat delete mode 100644 test/passing/tests/.ocp-indent delete mode 100644 test/passing/tests/alignment.ml.ref delete mode 100644 test/passing/tests/args_grouped-conventional.ml.err delete mode 100644 test/passing/tests/args_grouped-conventional.ml.opts delete mode 100644 test/passing/tests/args_grouped-conventional.ml.ref delete mode 100644 test/passing/tests/dir1/.ocamlformat delete mode 100644 test/passing/tests/dir1/dir2/.ocamlformat delete mode 100644 test/passing/tests/dir1/dir2/print_config.ml delete mode 100644 test/passing/tests/error1.ml.ref delete mode 100644 test/passing/tests/error2.ml.ref delete mode 100644 test/passing/tests/error3.ml.ref delete mode 100644 test/passing/tests/into_infix.opts delete mode 100644 test/passing/tests/js_sig.mli.opts delete mode 100644 test/passing/tests/js_source.ml.ocp delete mode 100644 test/passing/tests/js_source.ml.ocp-opts delete mode 100644 test/passing/tests/line_directives.ml.ref delete mode 100644 test/passing/tests/need_format.ml.ref delete mode 100644 test/passing/tests/polytypes-default.ml.opts delete mode 100644 test/passing/tests/polytypes-janestreet.ml.err delete mode 100644 test/passing/tests/polytypes-janestreet.ml.opts delete mode 100644 test/passing/tests/print_config.ml delete mode 100644 test/passing/tests/print_config.ml.deps delete mode 100644 test/passing/tests/print_config.ml.enabled-if delete mode 100644 test/passing/tests/print_config.ml.err delete mode 100644 test/passing/tests/print_config.ml.opts delete mode 100644 test/passing/tests/print_config.ml.ref delete mode 100644 test/passing/tests/profiles2.ml.opts delete mode 100644 test/passing/tests/record-default.ml.err delete mode 100644 test/passing/tests/record-default.ml.opts delete mode 100644 test/passing/tests/record_punning-js.ml.opts delete mode 100644 test/passing/tests/source-conventional.ml.err delete mode 100644 test/passing/tests/source-conventional.ml.opts delete mode 100644 test/passing/tests/verbose1.ml delete mode 100644 test/passing/tests/verbose1.ml.enabled-if delete mode 100644 test/passing/tests/verbose1.ml.err delete mode 100644 test/passing/tests/verbose1.ml.opts delete mode 100644 test/passing/tests/verbose1.ml.ref diff --git a/test/passing/dune b/test/passing/dune deleted file mode 100644 index 7dbc692d59..0000000000 --- a/test/passing/dune +++ /dev/null @@ -1,20 +0,0 @@ -(include dune.inc) - -(rule - (deps - (source_tree .)) - (package ocamlformat) - (enabled_if - (<> %{os_type} Win32)) - (action - (with-stdout-to - dune.inc.gen - (run ./gen/gen.exe)))) - -(rule - (alias runtest) - (package ocamlformat) - (enabled_if - (<> %{os_type} Win32)) - (action - (diff dune.inc dune.inc.gen))) diff --git a/test/passing/dune.inc b/test/passing/dune.inc deleted file mode 100644 index 70d271c3e7..0000000000 --- a/test/passing/dune.inc +++ /dev/null @@ -1,5711 +0,0 @@ - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to align_infix.ml.stdout - (with-stderr-to align_infix.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-infix=fit-or-vertical %{dep:tests/align_infix.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/align_infix.ml align_infix.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/align_infix.ml.err align_infix.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to alignment.ml.stdout - (with-stderr-to alignment.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/alignment.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/alignment.ml.ref alignment.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/alignment.ml.err alignment.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to apply.ml.stdout - (with-stderr-to apply.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/apply.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/apply.ml apply.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/apply.ml.err apply.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to apply_functor.ml.stdout - (with-stderr-to apply_functor.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/apply_functor.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/apply_functor.ml apply_functor.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/apply_functor.ml.err apply_functor.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to args_grouped-conventional.ml.stdout - (with-stderr-to args_grouped-conventional.ml.stderr - (run %{bin:ocamlformat} --margin-check --profile=conventional --margin=30 --max-iters=3 %{dep:tests/args_grouped.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/args_grouped-conventional.ml.ref args_grouped-conventional.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/args_grouped-conventional.ml.err args_grouped-conventional.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to args_grouped.ml.stdout - (with-stderr-to args_grouped.ml.stderr - (run %{bin:ocamlformat} --margin-check --profile=ocamlformat --margin=100 %{dep:tests/args_grouped.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/args_grouped.ml args_grouped.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/args_grouped.ml.err args_grouped.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to array.ml.stdout - (with-stderr-to array.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/array.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/array.ml array.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/array.ml.err array.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to assignment_operator-op_begin_line.ml.stdout - (with-stderr-to assignment_operator-op_begin_line.ml.stderr - (run %{bin:ocamlformat} --margin-check --assignment-operator=begin-line %{dep:tests/assignment_operator.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/assignment_operator-op_begin_line.ml.ref assignment_operator-op_begin_line.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/assignment_operator-op_begin_line.ml.err assignment_operator-op_begin_line.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to assignment_operator.ml.stdout - (with-stderr-to assignment_operator.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/assignment_operator.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/assignment_operator.ml.ref assignment_operator.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/assignment_operator.ml.err assignment_operator.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to attribute_and_expression.ml.stdout - (with-stderr-to attribute_and_expression.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/attribute_and_expression.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/attribute_and_expression.ml attribute_and_expression.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/attribute_and_expression.ml.err attribute_and_expression.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to attributes.ml.stdout - (with-stderr-to attributes.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/attributes.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/attributes.ml attributes.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/attributes.ml.err attributes.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to attributes.mli.stdout - (with-stderr-to attributes.mli.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/attributes.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/attributes.mli.ref attributes.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/attributes.mli.err attributes.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to binders.ml.stdout - (with-stderr-to binders.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/binders.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/binders.ml binders.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/binders.ml.err binders.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_before_in-auto.ml.stdout - (with-stderr-to break_before_in-auto.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-before-in=auto %{dep:tests/break_before_in.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_before_in-auto.ml.ref break_before_in-auto.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_before_in-auto.ml.err break_before_in-auto.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_before_in.ml.stdout - (with-stderr-to break_before_in.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-before-in=fit-or-vertical %{dep:tests/break_before_in.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_before_in.ml break_before_in.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_before_in.ml.err break_before_in.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to break_cases-align.ml.stdout - (with-stderr-to break_cases-align.ml.stderr - (run %{bin:ocamlformat} --margin-check --nested-match=align --break-cases=all %{dep:tests/break_cases.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-align.ml.ref break_cases-align.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-align.ml.err break_cases-align.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to break_cases-all.ml.stdout - (with-stderr-to break_cases-all.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-cases=all %{dep:tests/break_cases.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-all.ml.ref break_cases-all.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-all.ml.err break_cases-all.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to break_cases-closing_on_separate_line.ml.stdout - (with-stderr-to break_cases-closing_on_separate_line.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-cases=all --indicate-multiline-delimiters=closing-on-separate-line %{dep:tests/break_cases.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-closing_on_separate_line.ml.ref break_cases-closing_on_separate_line.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-closing_on_separate_line.ml.err break_cases-closing_on_separate_line.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_cases-closing_on_separate_line_fit_or_vertical.ml.stdout - (with-stderr-to break_cases-closing_on_separate_line_fit_or_vertical.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-cases=fit-or-vertical --indicate-multiline-delimiters=closing-on-separate-line %{dep:tests/break_cases.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_cases-closing_on_separate_line_fit_or_vertical.ml.ref break_cases-closing_on_separate_line_fit_or_vertical.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_cases-closing_on_separate_line_fit_or_vertical.ml.err break_cases-closing_on_separate_line_fit_or_vertical.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to break_cases-closing_on_separate_line_leading_nested_match_parens.ml.stdout - (with-stderr-to break_cases-closing_on_separate_line_leading_nested_match_parens.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-cases=all --indicate-multiline-delimiters=closing-on-separate-line --leading-nested-match-parens %{dep:tests/break_cases.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref break_cases-closing_on_separate_line_leading_nested_match_parens.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err break_cases-closing_on_separate_line_leading_nested_match_parens.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to break_cases-cosl_lnmp_cmei.ml.stdout - (with-stderr-to break_cases-cosl_lnmp_cmei.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-cases=all --indicate-multiline-delimiters=closing-on-separate-line --leading-nested-match-parens --cases-matching-exp-indent=normal %{dep:tests/break_cases.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-cosl_lnmp_cmei.ml.ref break_cases-cosl_lnmp_cmei.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-cosl_lnmp_cmei.ml.err break_cases-cosl_lnmp_cmei.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to break_cases-fit_or_vertical.ml.stdout - (with-stderr-to break_cases-fit_or_vertical.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-cases=fit-or-vertical %{dep:tests/break_cases.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-fit_or_vertical.ml.ref break_cases-fit_or_vertical.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-fit_or_vertical.ml.err break_cases-fit_or_vertical.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to break_cases-nested.ml.stdout - (with-stderr-to break_cases-nested.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-cases=nested %{dep:tests/break_cases.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-nested.ml.ref break_cases-nested.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-nested.ml.err break_cases-nested.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to break_cases-normal_indent.ml.stdout - (with-stderr-to break_cases-normal_indent.ml.stderr - (run %{bin:ocamlformat} --margin-check --cases-matching-exp-indent=normal --break-cases=all %{dep:tests/break_cases.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-normal_indent.ml.ref break_cases-normal_indent.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-normal_indent.ml.err break_cases-normal_indent.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_cases-toplevel.ml.stdout - (with-stderr-to break_cases-toplevel.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-cases=toplevel --max-iter=4 %{dep:tests/break_cases.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_cases-toplevel.ml.ref break_cases-toplevel.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_cases-toplevel.ml.err break_cases-toplevel.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to break_cases-vertical.ml.stdout - (with-stderr-to break_cases-vertical.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-cases=vertical %{dep:tests/break_cases.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-vertical.ml.ref break_cases-vertical.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/break_cases-vertical.ml.err break_cases-vertical.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_cases.ml.stdout - (with-stderr-to break_cases.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-cases=fit --max-iter=4 %{dep:tests/break_cases.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_cases.ml.ref break_cases.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_cases.ml.err break_cases.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_collection_expressions-wrap.ml.stdout - (with-stderr-to break_collection_expressions-wrap.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-collection-expressions=wrap --max-iters=3 %{dep:tests/break_collection_expressions.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_collection_expressions-wrap.ml.ref break_collection_expressions-wrap.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_collection_expressions-wrap.ml.err break_collection_expressions-wrap.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_collection_expressions.ml.stdout - (with-stderr-to break_collection_expressions.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-collection-expressions=fit-or-vertical --max-iters=3 %{dep:tests/break_collection_expressions.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_collection_expressions.ml.ref break_collection_expressions.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_collection_expressions.ml.err break_collection_expressions.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_colon-before.ml.stdout - (with-stderr-to break_colon-before.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-colon=before %{dep:tests/break_colon.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_colon-before.ml.ref break_colon-before.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_colon-before.ml.err break_colon-before.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_colon.ml.stdout - (with-stderr-to break_colon.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-colon=after %{dep:tests/break_colon.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_colon.ml break_colon.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_colon.ml.err break_colon.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_fun_decl-fit_or_vertical.ml.stdout - (with-stderr-to break_fun_decl-fit_or_vertical.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-fun-decl=fit-or-vertical --break-fun-sig=fit-or-vertical %{dep:tests/break_fun_decl.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_fun_decl-fit_or_vertical.ml.ref break_fun_decl-fit_or_vertical.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_fun_decl-fit_or_vertical.ml.err break_fun_decl-fit_or_vertical.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_fun_decl-smart.ml.stdout - (with-stderr-to break_fun_decl-smart.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-fun-decl=smart --break-fun-sig=smart %{dep:tests/break_fun_decl.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_fun_decl-smart.ml.ref break_fun_decl-smart.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_fun_decl-smart.ml.err break_fun_decl-smart.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_fun_decl-wrap.ml.stdout - (with-stderr-to break_fun_decl-wrap.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-fun-decl=wrap --break-fun-sig=wrap %{dep:tests/break_fun_decl.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_fun_decl-wrap.ml.ref break_fun_decl-wrap.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_fun_decl-wrap.ml.err break_fun_decl-wrap.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_fun_decl.ml.stdout - (with-stderr-to break_fun_decl.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/break_fun_decl.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_fun_decl.ml break_fun_decl.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_fun_decl.ml.err break_fun_decl.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_infix-fit-or-vertical.ml.stdout - (with-stderr-to break_infix-fit-or-vertical.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-infix=fit-or-vertical %{dep:tests/break_infix.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_infix-fit-or-vertical.ml.ref break_infix-fit-or-vertical.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_infix-fit-or-vertical.ml.err break_infix-fit-or-vertical.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_infix-wrap.ml.stdout - (with-stderr-to break_infix-wrap.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-infix=wrap %{dep:tests/break_infix.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_infix-wrap.ml.ref break_infix-wrap.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_infix-wrap.ml.err break_infix-wrap.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_infix.ml.stdout - (with-stderr-to break_infix.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-infix=wrap-or-vertical %{dep:tests/break_infix.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_infix.ml.ref break_infix.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_infix.ml.err break_infix.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_record.ml.stdout - (with-stderr-to break_record.ml.stderr - (run %{bin:ocamlformat} --margin-check --profile=janestreet --margin=58 %{dep:tests/break_record.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_record.ml break_record.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_record.ml.err break_record.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_separators-after.ml.stdout - (with-stderr-to break_separators-after.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-separators=after --max-iter=3 %{dep:tests/break_separators.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_separators-after.ml.ref break_separators-after.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_separators-after.ml.err break_separators-after.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_separators-after_docked.ml.stdout - (with-stderr-to break_separators-after_docked.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-separators=after --dock-collection-brackets --max-iter=3 %{dep:tests/break_separators.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_separators-after_docked.ml.ref break_separators-after_docked.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_separators-after_docked.ml.err break_separators-after_docked.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_separators-before_docked.ml.stdout - (with-stderr-to break_separators-before_docked.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-separators=before --dock-collection-brackets --max-iter=3 %{dep:tests/break_separators.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_separators-before_docked.ml.ref break_separators-before_docked.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_separators-before_docked.ml.err break_separators-before_docked.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_separators.ml.stdout - (with-stderr-to break_separators.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-separators=before --max-iter=3 %{dep:tests/break_separators.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_separators.ml break_separators.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_separators.ml.err break_separators.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_sequence_before.ml.stdout - (with-stderr-to break_sequence_before.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/break_sequence_before.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_sequence_before.ml break_sequence_before.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_sequence_before.ml.err break_sequence_before.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_string_literals-never.ml.stdout - (with-stderr-to break_string_literals-never.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-string-literals=never %{dep:tests/break_string_literals.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_string_literals-never.ml.ref break_string_literals-never.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_string_literals-never.ml.err break_string_literals-never.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_string_literals.ml.stdout - (with-stderr-to break_string_literals.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-string-literals=auto %{dep:tests/break_string_literals.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_string_literals.ml.ref break_string_literals.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_string_literals.ml.err break_string_literals.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to break_struct.ml.stdout - (with-stderr-to break_struct.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/break_struct.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_struct.ml.ref break_struct.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/break_struct.ml.err break_struct.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to cases_exp_grouping.ml.stdout - (with-stderr-to cases_exp_grouping.ml.stderr - (run %{bin:ocamlformat} --margin-check --exp-grouping=preserve %{dep:tests/cases_exp_grouping.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/cases_exp_grouping.ml.ref cases_exp_grouping.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/cases_exp_grouping.ml.err cases_exp_grouping.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to cinaps.ml.stdout - (with-stderr-to cinaps.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/cinaps.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/cinaps.ml.ref cinaps.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/cinaps.ml.err cinaps.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to class_expr.ml.stdout - (with-stderr-to class_expr.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/class_expr.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/class_expr.ml class_expr.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/class_expr.ml.err class_expr.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to class_sig-after.mli.stdout - (with-stderr-to class_sig-after.mli.stderr - (run %{bin:ocamlformat} --margin-check --break-separators=after %{dep:tests/class_sig.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/class_sig-after.mli.ref class_sig-after.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/class_sig-after.mli.err class_sig-after.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to class_sig.mli.stdout - (with-stderr-to class_sig.mli.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/class_sig.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/class_sig.mli.ref class_sig.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/class_sig.mli.err class_sig.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to class_type.ml.stdout - (with-stderr-to class_type.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iters=3 %{dep:tests/class_type.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/class_type.ml.ref class_type.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/class_type.ml.err class_type.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to cmdline_override.ml.stdout - (with-stderr-to cmdline_override.ml.stderr - (run %{bin:ocamlformat} --margin-check --config=module-item-spacing=compact --module-item-spacing=sparse %{dep:tests/cmdline_override.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/cmdline_override.ml cmdline_override.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/cmdline_override.ml.err cmdline_override.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to cmdline_override2.ml.stdout - (with-stderr-to cmdline_override2.ml.stderr - (run %{bin:ocamlformat} --margin-check --module-item-spacing=sparse --config=module-item-spacing=compact %{dep:tests/cmdline_override2.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/cmdline_override2.ml cmdline_override2.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/cmdline_override2.ml.err cmdline_override2.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to coerce.ml.stdout - (with-stderr-to coerce.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/coerce.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/coerce.ml coerce.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/coerce.ml.err coerce.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to comment_breaking.ml.stdout - (with-stderr-to comment_breaking.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/comment_breaking.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comment_breaking.ml comment_breaking.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comment_breaking.ml.err comment_breaking.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to comment_header.ml.stdout - (with-stderr-to comment_header.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/comment_header.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/comment_header.ml.ref comment_header.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/comment_header.ml.err comment_header.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to comment_in_empty.ml.stdout - (with-stderr-to comment_in_empty.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/comment_in_empty.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comment_in_empty.ml comment_in_empty.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comment_in_empty.ml.err comment_in_empty.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to comment_in_modules.ml.stdout - (with-stderr-to comment_in_modules.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/comment_in_modules.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comment_in_modules.ml.ref comment_in_modules.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comment_in_modules.ml.err comment_in_modules.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to comment_last.ml.stdout - (with-stderr-to comment_last.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/comment_last.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comment_last.ml comment_last.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comment_last.ml.err comment_last.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to comment_sparse.ml.stdout - (with-stderr-to comment_sparse.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/comment_sparse.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comment_sparse.ml comment_sparse.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comment_sparse.ml.err comment_sparse.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to comments-no-wrap.ml.stdout - (with-stderr-to comments-no-wrap.ml.stderr - (run %{bin:ocamlformat} --margin-check --no-wrap-comments --max-iter=4 %{dep:tests/comments.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments-no-wrap.ml.ref comments-no-wrap.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments-no-wrap.ml.err comments-no-wrap.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to comments.ml.stdout - (with-stderr-to comments.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iter=4 %{dep:tests/comments.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments.ml.ref comments.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments.ml.err comments.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to comments.mli.stdout - (with-stderr-to comments.mli.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/comments.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments.mli comments.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments.mli.err comments.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to comments_args.ml.stdout - (with-stderr-to comments_args.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iter=4 %{dep:tests/comments_args.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments_args.ml.ref comments_args.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments_args.ml.err comments_args.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to comments_around_disabled.ml.stdout - (with-stderr-to comments_around_disabled.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/comments_around_disabled.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments_around_disabled.ml.ref comments_around_disabled.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments_around_disabled.ml.err comments_around_disabled.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to comments_in_local_let.ml.stdout - (with-stderr-to comments_in_local_let.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/comments_in_local_let.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments_in_local_let.ml comments_in_local_let.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments_in_local_let.ml.err comments_in_local_let.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to comments_in_record-break_separator-after.ml.stdout - (with-stderr-to comments_in_record-break_separator-after.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-separator=after %{dep:tests/comments_in_record.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments_in_record-break_separator-after.ml.ref comments_in_record-break_separator-after.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments_in_record-break_separator-after.ml.err comments_in_record-break_separator-after.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to comments_in_record-break_separator-before.ml.stdout - (with-stderr-to comments_in_record-break_separator-before.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-separator=before %{dep:tests/comments_in_record.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments_in_record-break_separator-before.ml.ref comments_in_record-break_separator-before.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments_in_record-break_separator-before.ml.err comments_in_record-break_separator-before.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to comments_in_record.ml.stdout - (with-stderr-to comments_in_record.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/comments_in_record.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments_in_record.ml.ref comments_in_record.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/comments_in_record.ml.err comments_in_record.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to crlf_to_crlf.ml.stdout - (with-stderr-to crlf_to_crlf.ml.stderr - (run %{bin:ocamlformat} --margin-check --line-endings=crlf %{dep:tests/crlf_to_crlf.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/crlf_to_crlf.ml.ref crlf_to_crlf.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/crlf_to_crlf.ml.err crlf_to_crlf.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to crlf_to_lf.ml.stdout - (with-stderr-to crlf_to_lf.ml.stderr - (run %{bin:ocamlformat} --margin-check --line-endings=lf %{dep:tests/crlf_to_lf.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/crlf_to_lf.ml.ref crlf_to_lf.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/crlf_to_lf.ml.err crlf_to_lf.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to custom_list.ml.stdout - (with-stderr-to custom_list.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/custom_list.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/custom_list.ml custom_list.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/custom_list.ml.err custom_list.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to directives.mlt.stdout - (with-stderr-to directives.mlt.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/directives.mlt}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/directives.mlt.ref directives.mlt.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/directives.mlt.err directives.mlt.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to disable_attr.ml.stdout - (with-stderr-to disable_attr.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/disable_attr.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/disable_attr.ml disable_attr.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/disable_attr.ml.err disable_attr.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to disable_class_type.ml.stdout - (with-stderr-to disable_class_type.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/disable_class_type.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/disable_class_type.ml disable_class_type.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/disable_class_type.ml.err disable_class_type.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to disable_conf_attrs.ml.stdout - (with-stderr-to disable_conf_attrs.ml.stderr - (run %{bin:ocamlformat} --margin-check --disable-conf-attrs %{dep:tests/disable_conf_attrs.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/disable_conf_attrs.ml.ref disable_conf_attrs.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/disable_conf_attrs.ml.err disable_conf_attrs.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to disable_local_let.ml.stdout - (with-stderr-to disable_local_let.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/disable_local_let.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/disable_local_let.ml disable_local_let.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/disable_local_let.ml.err disable_local_let.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to disabled.ml.stdout - (with-stderr-to disabled.ml.stderr - (run %{bin:ocamlformat} --margin-check --disable %{dep:tests/disabled.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/disabled.ml disabled.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/disabled.ml.err disabled.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to disabled_attr.ml.stdout - (with-stderr-to disabled_attr.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/disabled_attr.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/disabled_attr.ml disabled_attr.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/disabled_attr.ml.err disabled_attr.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to disambiguate.ml.stdout - (with-stderr-to disambiguate.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/disambiguate.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/disambiguate.ml disambiguate.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/disambiguate.ml.err disambiguate.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to disambiguated_types.ml.stdout - (with-stderr-to disambiguated_types.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/disambiguated_types.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/disambiguated_types.ml disambiguated_types.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/disambiguated_types.ml.err disambiguated_types.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to doc.mld.stdout - (with-stderr-to doc.mld.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/doc.mld}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/doc.mld.ref doc.mld.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/doc.mld.err doc.mld.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to doc_comments-after.ml.stdout - (with-stderr-to doc_comments-after.ml.stderr - (run %{bin:ocamlformat} --margin-check --doc-comments=after-when-possible %{dep:tests/doc_comments.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/doc_comments-after.ml.ref doc_comments-after.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/doc_comments-after.ml.err doc_comments-after.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to doc_comments-before-except-val.ml.stdout - (with-stderr-to doc_comments-before-except-val.ml.stderr - (run %{bin:ocamlformat} --margin-check --doc-comments=before-except-val %{dep:tests/doc_comments.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/doc_comments-before-except-val.ml.ref doc_comments-before-except-val.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/doc_comments-before-except-val.ml.err doc_comments-before-except-val.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to doc_comments-before.ml.stdout - (with-stderr-to doc_comments-before.ml.stderr - (run %{bin:ocamlformat} --margin-check --doc-comments=before %{dep:tests/doc_comments.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/doc_comments-before.ml.ref doc_comments-before.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/doc_comments-before.ml.err doc_comments-before.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to doc_comments-no-parse-docstrings.mli.stdout - (with-stderr-to doc_comments-no-parse-docstrings.mli.stderr - (run %{bin:ocamlformat} --margin-check --no-parse-docstrings --max-iters=3 %{dep:tests/doc_comments.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/doc_comments-no-parse-docstrings.mli.ref doc_comments-no-parse-docstrings.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/doc_comments-no-parse-docstrings.mli.err doc_comments-no-parse-docstrings.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to doc_comments-no-wrap.mli.stdout - (with-stderr-to doc_comments-no-wrap.mli.stderr - (run %{bin:ocamlformat} --margin-check --no-wrap-comments %{dep:tests/doc_comments.mli}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/doc_comments-no-wrap.mli.ref doc_comments-no-wrap.mli.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/doc_comments-no-wrap.mli.err doc_comments-no-wrap.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to doc_comments.ml.stdout - (with-stderr-to doc_comments.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/doc_comments.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/doc_comments.ml.ref doc_comments.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/doc_comments.ml.err doc_comments.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to doc_comments.mli.stdout - (with-stderr-to doc_comments.mli.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/doc_comments.mli}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/doc_comments.mli.ref doc_comments.mli.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/doc_comments.mli.err doc_comments.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to doc_comments_padding.ml.stdout - (with-stderr-to doc_comments_padding.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/doc_comments_padding.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/doc_comments_padding.ml doc_comments_padding.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/doc_comments_padding.ml.err doc_comments_padding.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to doc_repl.mld.stdout - (with-stderr-to doc_repl.mld.stderr - (run %{bin:ocamlformat} --margin-check --parse-toplevel-phrases %{dep:tests/doc_repl.mld}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/doc_repl.mld.ref doc_repl.mld.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/doc_repl.mld.err doc_repl.mld.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to docstrings_toplevel_directives.mlt.stdout - (with-stderr-to docstrings_toplevel_directives.mlt.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/docstrings_toplevel_directives.mlt}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/docstrings_toplevel_directives.mlt docstrings_toplevel_directives.mlt.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/docstrings_toplevel_directives.mlt.err docstrings_toplevel_directives.mlt.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to eliom_ext.eliom.stdout - (with-stderr-to eliom_ext.eliom.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/eliom_ext.eliom}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/eliom_ext.eliom eliom_ext.eliom.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/eliom_ext.eliom.err eliom_ext.eliom.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to empty.ml.stdout - (with-stderr-to empty.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/empty.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/empty.ml empty.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/empty.ml.err empty.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to empty_ml.ml.stdout - (with-stderr-to empty_ml.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/empty_ml.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/empty_ml.ml empty_ml.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/empty_ml.ml.err empty_ml.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to empty_mli.mli.stdout - (with-stderr-to empty_mli.mli.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/empty_mli.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/empty_mli.mli empty_mli.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/empty_mli.mli.err empty_mli.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to empty_mlt.mlt.stdout - (with-stderr-to empty_mlt.mlt.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/empty_mlt.mlt}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/empty_mlt.mlt empty_mlt.mlt.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/empty_mlt.mlt.err empty_mlt.mlt.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to error1.ml.stdout - (with-stderr-to error1.ml.stderr - (with-accepted-exit-codes 1 - (run %{bin:ocamlformat} --margin-check %{dep:tests/error1.ml})))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/error1.ml.ref error1.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/error1.ml.err error1.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to error2.ml.stdout - (with-stderr-to error2.ml.stderr - (with-accepted-exit-codes 1 - (run %{bin:ocamlformat} --margin-check %{dep:tests/error2.ml})))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/error2.ml.ref error2.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/error2.ml.err error2.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to error3.ml.stdout - (with-stderr-to error3.ml.stderr - (with-accepted-exit-codes 1 - (run %{bin:ocamlformat} --margin-check %{dep:tests/error3.ml})))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/error3.ml.ref error3.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/error3.ml.err error3.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to error4.ml.stdout - (with-stderr-to error4.ml.stderr - (run %{bin:ocamlformat} --margin-check --no-comment-check %{dep:tests/error4.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/error4.ml.ref error4.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/error4.ml.err error4.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to escaped_nl.ml.stdout - (with-stderr-to escaped_nl.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/escaped_nl.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/escaped_nl.ml.ref escaped_nl.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/escaped_nl.ml.err escaped_nl.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to exceptions.ml.stdout - (with-stderr-to exceptions.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/exceptions.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/exceptions.ml exceptions.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/exceptions.ml.err exceptions.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to exceptions.mli.stdout - (with-stderr-to exceptions.mli.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/exceptions.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/exceptions.mli exceptions.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/exceptions.mli.err exceptions.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to exp_grouping-parens.ml.stdout - (with-stderr-to exp_grouping-parens.ml.stderr - (run %{bin:ocamlformat} --margin-check --exp-grouping=parens %{dep:tests/exp_grouping.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/exp_grouping-parens.ml.ref exp_grouping-parens.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/exp_grouping-parens.ml.err exp_grouping-parens.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to exp_grouping.ml.stdout - (with-stderr-to exp_grouping.ml.stderr - (run %{bin:ocamlformat} --margin-check --exp-grouping=preserve %{dep:tests/exp_grouping.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/exp_grouping.ml.ref exp_grouping.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/exp_grouping.ml.err exp_grouping.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to exp_record.ml.stdout - (with-stderr-to exp_record.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/exp_record.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/exp_record.ml exp_record.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/exp_record.ml.err exp_record.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to expect_test.ml.stdout - (with-stderr-to expect_test.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/expect_test.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/expect_test.ml expect_test.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/expect_test.ml.err expect_test.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to extensions-indent.ml.stdout - (with-stderr-to extensions-indent.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iters=3 --extension-indent=5 --stritem-extension-indent=3 %{dep:tests/extensions.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/extensions-indent.ml.ref extensions-indent.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/extensions-indent.ml.err extensions-indent.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to extensions-indent.mli.stdout - (with-stderr-to extensions-indent.mli.stderr - (run %{bin:ocamlformat} --margin-check --extension-indent=5 --stritem-extension-indent=3 %{dep:tests/extensions.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/extensions-indent.mli.ref extensions-indent.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/extensions-indent.mli.err extensions-indent.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to extensions.ml.stdout - (with-stderr-to extensions.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iters=3 %{dep:tests/extensions.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/extensions.ml.ref extensions.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/extensions.ml.err extensions.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to extensions.mli.stdout - (with-stderr-to extensions.mli.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/extensions.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/extensions.mli extensions.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/extensions.mli.err extensions.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to extensions_exp_grouping.ml.stdout - (with-stderr-to extensions_exp_grouping.ml.stderr - (run %{bin:ocamlformat} --margin-check --exp-grouping=preserve %{dep:tests/extensions_exp_grouping.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/extensions_exp_grouping.ml.ref extensions_exp_grouping.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/extensions_exp_grouping.ml.err extensions_exp_grouping.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to field-op_begin_line.ml.stdout - (with-stderr-to field-op_begin_line.ml.stderr - (run %{bin:ocamlformat} --margin-check --assignment-operator=begin-line %{dep:tests/field.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/field-op_begin_line.ml.ref field-op_begin_line.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/field-op_begin_line.ml.err field-op_begin_line.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to field.ml.stdout - (with-stderr-to field.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/field.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/field.ml field.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/field.ml.err field.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to first_class_module.ml.stdout - (with-stderr-to first_class_module.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/first_class_module.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/first_class_module.ml.ref first_class_module.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/first_class_module.ml.err first_class_module.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to floating_doc.ml.stdout - (with-stderr-to floating_doc.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/floating_doc.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/floating_doc.ml floating_doc.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/floating_doc.ml.err floating_doc.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to for_while.ml.stdout - (with-stderr-to for_while.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/for_while.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/for_while.ml for_while.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/for_while.ml.err for_while.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to fun_decl-no-wrap-fun-args.ml.stdout - (with-stderr-to fun_decl-no-wrap-fun-args.ml.stderr - (run %{bin:ocamlformat} --margin-check --no-wrap-fun-args %{dep:tests/fun_decl.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/fun_decl-no-wrap-fun-args.ml.ref fun_decl-no-wrap-fun-args.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/fun_decl-no-wrap-fun-args.ml.err fun_decl-no-wrap-fun-args.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to fun_decl.ml.stdout - (with-stderr-to fun_decl.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/fun_decl.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/fun_decl.ml.ref fun_decl.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/fun_decl.ml.err fun_decl.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to fun_function.ml.stdout - (with-stderr-to fun_function.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iter=3 %{dep:tests/fun_function.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/fun_function.ml.ref fun_function.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/fun_function.ml.err fun_function.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to function_indent-never.ml.stdout - (with-stderr-to function_indent-never.ml.stderr - (run %{bin:ocamlformat} --margin-check --function-indent=4 --function-indent-nested=never %{dep:tests/function_indent.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/function_indent-never.ml.ref function_indent-never.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/function_indent-never.ml.err function_indent-never.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to function_indent.ml.stdout - (with-stderr-to function_indent.ml.stderr - (run %{bin:ocamlformat} --margin-check --function-indent=4 --function-indent-nested=always %{dep:tests/function_indent.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/function_indent.ml.ref function_indent.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/function_indent.ml.err function_indent.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to functor.ml.stdout - (with-stderr-to functor.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/functor.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/functor.ml.ref functor.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/functor.ml.err functor.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to functor.mli.stdout - (with-stderr-to functor.mli.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/functor.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/functor.mli functor.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/functor.mli.err functor.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to funsig.ml.stdout - (with-stderr-to funsig.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/funsig.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/funsig.ml funsig.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/funsig.ml.err funsig.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to gadt.ml.stdout - (with-stderr-to gadt.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/gadt.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/gadt.ml gadt.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/gadt.ml.err gadt.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to generative.ml.stdout - (with-stderr-to generative.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iters=3 %{dep:tests/generative.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/generative.ml.ref generative.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/generative.ml.err generative.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to hash_bang.ml.stdout - (with-stderr-to hash_bang.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/hash_bang.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/hash_bang.ml hash_bang.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/hash_bang.ml.err hash_bang.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to hash_types.ml.stdout - (with-stderr-to hash_types.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/hash_types.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/hash_types.ml hash_types.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/hash_types.ml.err hash_types.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to holes.ml.stdout - (with-stderr-to holes.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/holes.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/holes.ml.ref holes.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/holes.ml.err holes.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ifand.ml.stdout - (with-stderr-to ifand.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/ifand.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ifand.ml.ref ifand.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ifand.ml.err ifand.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to index_op.ml.stdout - (with-stderr-to index_op.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/index_op.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/index_op.ml index_op.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/index_op.ml.err index_op.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to indicate_multiline_delimiters-cosl.ml.stdout - (with-stderr-to indicate_multiline_delimiters-cosl.ml.stderr - (run %{bin:ocamlformat} --margin-check --indicate-multiline-delimiters=closing-on-separate-line %{dep:tests/indicate_multiline_delimiters.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/indicate_multiline_delimiters-cosl.ml.ref indicate_multiline_delimiters-cosl.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/indicate_multiline_delimiters-cosl.ml.err indicate_multiline_delimiters-cosl.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to indicate_multiline_delimiters-space.ml.stdout - (with-stderr-to indicate_multiline_delimiters-space.ml.stderr - (run %{bin:ocamlformat} --margin-check --indicate-multiline-delimiters=space %{dep:tests/indicate_multiline_delimiters.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/indicate_multiline_delimiters-space.ml.ref indicate_multiline_delimiters-space.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/indicate_multiline_delimiters-space.ml.err indicate_multiline_delimiters-space.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to indicate_multiline_delimiters.ml.stdout - (with-stderr-to indicate_multiline_delimiters.ml.stderr - (run %{bin:ocamlformat} --margin-check --indicate-multiline-delimiters=no %{dep:tests/indicate_multiline_delimiters.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/indicate_multiline_delimiters.ml indicate_multiline_delimiters.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/indicate_multiline_delimiters.ml.err indicate_multiline_delimiters.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to infix_arg_grouping.ml.stdout - (with-stderr-to infix_arg_grouping.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/infix_arg_grouping.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/infix_arg_grouping.ml.ref infix_arg_grouping.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/infix_arg_grouping.ml.err infix_arg_grouping.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to infix_bind-break.ml.stdout - (with-stderr-to infix_bind-break.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-infix=wrap --break-infix-before-func --max-iters=3 %{dep:tests/infix_bind.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/infix_bind-break.ml.ref infix_bind-break.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/infix_bind-break.ml.err infix_bind-break.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to infix_bind-fit_or_vertical-break.ml.stdout - (with-stderr-to infix_bind-fit_or_vertical-break.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-infix=fit-or-vertical --break-infix-before-func --max-iters=3 %{dep:tests/infix_bind.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/infix_bind-fit_or_vertical-break.ml.ref infix_bind-fit_or_vertical-break.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/infix_bind-fit_or_vertical-break.ml.err infix_bind-fit_or_vertical-break.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to infix_bind-fit_or_vertical.ml.stdout - (with-stderr-to infix_bind-fit_or_vertical.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-infix=fit-or-vertical --no-break-infix-before-func %{dep:tests/infix_bind.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/infix_bind-fit_or_vertical.ml.ref infix_bind-fit_or_vertical.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/infix_bind-fit_or_vertical.ml.err infix_bind-fit_or_vertical.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to infix_bind.ml.stdout - (with-stderr-to infix_bind.ml.stderr - (run %{bin:ocamlformat} --margin-check --break-infix=wrap --no-break-infix-before-func %{dep:tests/infix_bind.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/infix_bind.ml infix_bind.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/infix_bind.ml.err infix_bind.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to infix_precedence.ml.stdout - (with-stderr-to infix_precedence.ml.stderr - (run %{bin:ocamlformat} --margin-check --infix-precedence=parens %{dep:tests/infix_precedence.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/infix_precedence.ml infix_precedence.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/infix_precedence.ml.err infix_precedence.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to injectivity.ml.stdout - (with-stderr-to injectivity.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/injectivity.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/injectivity.ml injectivity.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/injectivity.ml.err injectivity.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to into_infix.ml.stdout - (with-stderr-to into_infix.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/into_infix.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/into_infix.ml.ref into_infix.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/into_infix.ml.err into_infix.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to invalid.ml.stdout - (with-stderr-to invalid.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/invalid.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/invalid.ml invalid.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/invalid.ml.err invalid.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to invalid_docstring.ml.stdout - (with-stderr-to invalid_docstring.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/invalid_docstring.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/invalid_docstring.ml.ref invalid_docstring.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/invalid_docstring.ml.err invalid_docstring.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to invalid_docstrings.mli.stdout - (with-stderr-to invalid_docstrings.mli.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/invalid_docstrings.mli}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/invalid_docstrings.mli.ref invalid_docstrings.mli.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/invalid_docstrings.mli.err invalid_docstrings.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to issue114.ml.stdout - (with-stderr-to issue114.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/issue114.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue114.ml issue114.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue114.ml.err issue114.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to issue1750.ml.stdout - (with-stderr-to issue1750.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/issue1750.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue1750.ml issue1750.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue1750.ml.err issue1750.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to issue289.ml.stdout - (with-stderr-to issue289.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/issue289.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue289.ml issue289.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue289.ml.err issue289.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to issue48.ml.stdout - (with-stderr-to issue48.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/issue48.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue48.ml issue48.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue48.ml.err issue48.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to issue51.ml.stdout - (with-stderr-to issue51.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/issue51.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue51.ml issue51.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue51.ml.err issue51.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to issue57.ml.stdout - (with-stderr-to issue57.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/issue57.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue57.ml issue57.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue57.ml.err issue57.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to issue60.ml.stdout - (with-stderr-to issue60.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/issue60.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue60.ml issue60.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue60.ml.err issue60.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to issue77.ml.stdout - (with-stderr-to issue77.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/issue77.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue77.ml issue77.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue77.ml.err issue77.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to issue85.ml.stdout - (with-stderr-to issue85.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/issue85.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue85.ml issue85.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue85.ml.err issue85.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to issue89.ml.stdout - (with-stderr-to issue89.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/issue89.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue89.ml issue89.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/issue89.ml.err issue89.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ite-compact.ml.stdout - (with-stderr-to ite-compact.ml.stderr - (run %{bin:ocamlformat} --margin-check --if-then-else=compact %{dep:tests/ite.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-compact.ml.ref ite-compact.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-compact.ml.err ite-compact.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ite-compact_closing.ml.stdout - (with-stderr-to ite-compact_closing.ml.stderr - (run %{bin:ocamlformat} --margin-check --if-then-else=compact --indicate-multiline-delimiters=closing-on-separate-line %{dep:tests/ite.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-compact_closing.ml.ref ite-compact_closing.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-compact_closing.ml.err ite-compact_closing.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ite-fit_or_vertical.ml.stdout - (with-stderr-to ite-fit_or_vertical.ml.stderr - (run %{bin:ocamlformat} --margin-check --if-then-else=fit-or-vertical %{dep:tests/ite.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-fit_or_vertical.ml.ref ite-fit_or_vertical.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-fit_or_vertical.ml.err ite-fit_or_vertical.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ite-fit_or_vertical_closing.ml.stdout - (with-stderr-to ite-fit_or_vertical_closing.ml.stderr - (run %{bin:ocamlformat} --margin-check --if-then-else fit-or-vertical --indicate-multiline-delimiters=closing-on-separate-line %{dep:tests/ite.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-fit_or_vertical_closing.ml.ref ite-fit_or_vertical_closing.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-fit_or_vertical_closing.ml.err ite-fit_or_vertical_closing.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ite-fit_or_vertical_no_indicate.ml.stdout - (with-stderr-to ite-fit_or_vertical_no_indicate.ml.stderr - (run %{bin:ocamlformat} --margin-check --if-then-else=fit-or-vertical --indicate-multiline-delimiters=no %{dep:tests/ite.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-fit_or_vertical_no_indicate.ml.ref ite-fit_or_vertical_no_indicate.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-fit_or_vertical_no_indicate.ml.err ite-fit_or_vertical_no_indicate.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ite-kr.ml.stdout - (with-stderr-to ite-kr.ml.stderr - (run %{bin:ocamlformat} --margin-check --if-then-else=k-r --max-iters=3 %{dep:tests/ite.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-kr.ml.ref ite-kr.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-kr.ml.err ite-kr.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ite-kr_closing.ml.stdout - (with-stderr-to ite-kr_closing.ml.stderr - (run %{bin:ocamlformat} --margin-check --if-then-else=k-r --max-iters=3 --indicate-multiline-delimiters=closing-on-separate-line %{dep:tests/ite.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-kr_closing.ml.ref ite-kr_closing.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-kr_closing.ml.err ite-kr_closing.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ite-kw_first.ml.stdout - (with-stderr-to ite-kw_first.ml.stderr - (run %{bin:ocamlformat} --margin-check --if-then-else=keyword-first %{dep:tests/ite.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-kw_first.ml.ref ite-kw_first.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-kw_first.ml.err ite-kw_first.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ite-kw_first_closing.ml.stdout - (with-stderr-to ite-kw_first_closing.ml.stderr - (run %{bin:ocamlformat} --margin-check --if-then-else keyword-first --indicate-multiline-delimiters=closing-on-separate-line %{dep:tests/ite.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-kw_first_closing.ml.ref ite-kw_first_closing.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-kw_first_closing.ml.err ite-kw_first_closing.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ite-kw_first_no_indicate.ml.stdout - (with-stderr-to ite-kw_first_no_indicate.ml.stderr - (run %{bin:ocamlformat} --margin-check --if-then-else=keyword-first --indicate-multiline-delimiters=no %{dep:tests/ite.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-kw_first_no_indicate.ml.ref ite-kw_first_no_indicate.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-kw_first_no_indicate.ml.err ite-kw_first_no_indicate.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ite-no_indicate.ml.stdout - (with-stderr-to ite-no_indicate.ml.stderr - (run %{bin:ocamlformat} --margin-check --if-then-else=compact --indicate-multiline-delimiters=no %{dep:tests/ite.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-no_indicate.ml.ref ite-no_indicate.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-no_indicate.ml.err ite-no_indicate.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ite-vertical.ml.stdout - (with-stderr-to ite-vertical.ml.stderr - (run %{bin:ocamlformat} --margin-check --if-then-else=vertical %{dep:tests/ite.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-vertical.ml.ref ite-vertical.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite-vertical.ml.err ite-vertical.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ite.ml.stdout - (with-stderr-to ite.ml.stderr - (run %{bin:ocamlformat} --margin-check --if-then-else=compact %{dep:tests/ite.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite.ml.ref ite.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ite.ml.err ite.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to js_args.ml.stdout - (with-stderr-to js_args.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iter=3 %{dep:tests/js_args.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_args.ml.ref js_args.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_args.ml.err js_args.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to js_begin.ml.stdout - (with-stderr-to js_begin.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/js_begin.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_begin.ml.ref js_begin.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_begin.ml.err js_begin.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to js_bind.ml.stdout - (with-stderr-to js_bind.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/js_bind.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_bind.ml.ref js_bind.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_bind.ml.err js_bind.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to js_fun.ml.stdout - (with-stderr-to js_fun.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iter=3 %{dep:tests/js_fun.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_fun.ml.ref js_fun.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_fun.ml.err js_fun.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to js_map.ml.stdout - (with-stderr-to js_map.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iter=3 %{dep:tests/js_map.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_map.ml.ref js_map.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_map.ml.err js_map.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to js_pattern.ml.stdout - (with-stderr-to js_pattern.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/js_pattern.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_pattern.ml.ref js_pattern.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_pattern.ml.err js_pattern.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to js_poly.ml.stdout - (with-stderr-to js_poly.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iter=3 %{dep:tests/js_poly.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_poly.ml.ref js_poly.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_poly.ml.err js_poly.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to js_record.ml.stdout - (with-stderr-to js_record.ml.stderr - (run %{bin:ocamlformat} --margin-check --profile=janestreet --max-iter=3 %{dep:tests/js_record.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_record.ml.ref js_record.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_record.ml.err js_record.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to js_sig.mli.stdout - (with-stderr-to js_sig.mli.stderr - (run %{bin:ocamlformat} --margin-check --profile=janestreet %{dep:tests/js_sig.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_sig.mli.ref js_sig.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_sig.mli.err js_sig.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to js_source.ml.stdout - (with-stderr-to js_source.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iters=3 --profile=janestreet %{dep:tests/js_source.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_source.ml.ref js_source.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_source.ml.err js_source.ml.stderr))) - -(rule - (deps tests/.ocp-indent ) - (package ocamlformat) - (action - (with-outputs-to js_source.ml.ocp.output - (run %{bin:ocp-indent} --config JaneStreet %{dep:js_source.ml.stdout})))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_source.ml.ocp js_source.ml.ocp.output))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to js_syntax.ml.stdout - (with-stderr-to js_syntax.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/js_syntax.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_syntax.ml.ref js_syntax.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_syntax.ml.err js_syntax.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to js_to_do.ml.stdout - (with-stderr-to js_to_do.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/js_to_do.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/js_to_do.ml.ref js_to_do.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/js_to_do.ml.err js_to_do.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to js_upon.ml.stdout - (with-stderr-to js_upon.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/js_upon.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_upon.ml.ref js_upon.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/js_upon.ml.err js_upon.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to kw_extentions.ml.stdout - (with-stderr-to kw_extentions.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/kw_extentions.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/kw_extentions.ml kw_extentions.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/kw_extentions.ml.err kw_extentions.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to label_option_default_args.ml.stdout - (with-stderr-to label_option_default_args.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iters=4 %{dep:tests/label_option_default_args.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/label_option_default_args.ml.ref label_option_default_args.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/label_option_default_args.ml.err label_option_default_args.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to labelled_args-414.ml.stdout - (with-stderr-to labelled_args-414.ml.stderr - (run %{bin:ocamlformat} --margin-check --ocaml-version=4.14.0 %{dep:tests/labelled_args.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/labelled_args-414.ml.ref labelled_args-414.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/labelled_args-414.ml.err labelled_args-414.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to labelled_args.ml.stdout - (with-stderr-to labelled_args.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/labelled_args.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/labelled_args.ml labelled_args.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/labelled_args.ml.err labelled_args.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to lazy.ml.stdout - (with-stderr-to lazy.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/lazy.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/lazy.ml lazy.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/lazy.ml.err lazy.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to let_binding-deindent-fun.ml.stdout - (with-stderr-to let_binding-deindent-fun.ml.stderr - (run %{bin:ocamlformat} --margin-check --no-let-binding-deindent-fun %{dep:tests/let_binding.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_binding-deindent-fun.ml.ref let_binding-deindent-fun.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_binding-deindent-fun.ml.err let_binding-deindent-fun.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to let_binding-in_indent.ml.stdout - (with-stderr-to let_binding-in_indent.ml.stderr - (run %{bin:ocamlformat} --margin-check --indent-after-in=4 %{dep:tests/let_binding.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_binding-in_indent.ml.ref let_binding-in_indent.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_binding-in_indent.ml.err let_binding-in_indent.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to let_binding-indent.ml.stdout - (with-stderr-to let_binding-indent.ml.stderr - (run %{bin:ocamlformat} --margin-check --let-binding-indent=6 %{dep:tests/let_binding.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_binding-indent.ml.ref let_binding-indent.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_binding-indent.ml.err let_binding-indent.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to let_binding.ml.stdout - (with-stderr-to let_binding.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/let_binding.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_binding.ml.ref let_binding.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_binding.ml.err let_binding.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to let_binding_spacing-double-semicolon.ml.stdout - (with-stderr-to let_binding_spacing-double-semicolon.ml.stderr - (run %{bin:ocamlformat} --margin-check --let-binding-spacing=double-semicolon %{dep:tests/let_binding_spacing.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_binding_spacing-double-semicolon.ml.ref let_binding_spacing-double-semicolon.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_binding_spacing-double-semicolon.ml.err let_binding_spacing-double-semicolon.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to let_binding_spacing-sparse.ml.stdout - (with-stderr-to let_binding_spacing-sparse.ml.stderr - (run %{bin:ocamlformat} --margin-check --let-binding-spacing=sparse %{dep:tests/let_binding_spacing.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_binding_spacing-sparse.ml.ref let_binding_spacing-sparse.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_binding_spacing-sparse.ml.err let_binding_spacing-sparse.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to let_binding_spacing.ml.stdout - (with-stderr-to let_binding_spacing.ml.stderr - (run %{bin:ocamlformat} --margin-check --let-binding-spacing=compact %{dep:tests/let_binding_spacing.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_binding_spacing.ml let_binding_spacing.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_binding_spacing.ml.err let_binding_spacing.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to let_in_constr.ml.stdout - (with-stderr-to let_in_constr.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/let_in_constr.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_in_constr.ml let_in_constr.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_in_constr.ml.err let_in_constr.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to let_module-sparse.ml.stdout - (with-stderr-to let_module-sparse.ml.stderr - (run %{bin:ocamlformat} --margin-check --let-module=sparse %{dep:tests/let_module.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_module-sparse.ml.ref let_module-sparse.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_module-sparse.ml.err let_module-sparse.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to let_module.ml.stdout - (with-stderr-to let_module.ml.stderr - (run %{bin:ocamlformat} --margin-check --let-module=compact %{dep:tests/let_module.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_module.ml.ref let_module.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_module.ml.err let_module.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to let_punning.ml.stdout - (with-stderr-to let_punning.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/let_punning.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_punning.ml let_punning.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/let_punning.ml.err let_punning.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to line_directives.ml.stdout - (with-stderr-to line_directives.ml.stderr - (with-accepted-exit-codes 1 - (run %{bin:ocamlformat} --margin-check %{dep:tests/line_directives.ml})))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/line_directives.ml.ref line_directives.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/line_directives.ml.err line_directives.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to list-space_around.ml.stdout - (with-stderr-to list-space_around.ml.stderr - (run %{bin:ocamlformat} --margin-check --space-around-arrays --space-around-lists --space-around-records --space-around-variants %{dep:tests/list.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/list-space_around.ml.ref list-space_around.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/list-space_around.ml.err list-space_around.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to list.ml.stdout - (with-stderr-to list.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/list.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/list.ml list.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/list.ml.err list.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to list_and_comments.ml.stdout - (with-stderr-to list_and_comments.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/list_and_comments.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/list_and_comments.ml.ref list_and_comments.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/list_and_comments.ml.err list_and_comments.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to list_normalized.ml.stdout - (with-stderr-to list_normalized.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iters=4 %{dep:tests/list_normalized.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/list_normalized.ml.ref list_normalized.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/list_normalized.ml.err list_normalized.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to loc_stack.ml.stdout - (with-stderr-to loc_stack.ml.stderr - (run %{bin:ocamlformat} --margin-check -n 3 %{dep:tests/loc_stack.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/loc_stack.ml.ref loc_stack.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/loc_stack.ml.err loc_stack.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to locally_abtract_types.ml.stdout - (with-stderr-to locally_abtract_types.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/locally_abtract_types.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/locally_abtract_types.ml locally_abtract_types.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/locally_abtract_types.ml.err locally_abtract_types.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to margin_80.ml.stdout - (with-stderr-to margin_80.ml.stderr - (run %{bin:ocamlformat} --margin-check --margin=80 %{dep:tests/margin_80.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/margin_80.ml.ref margin_80.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/margin_80.ml.err margin_80.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to match.ml.stdout - (with-stderr-to match.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/match.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/match.ml match.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/match.ml.err match.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to match2.ml.stdout - (with-stderr-to match2.ml.stderr - (run %{bin:ocamlformat} --margin-check --leading-nested-match-parens %{dep:tests/match2.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/match2.ml match2.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/match2.ml.err match2.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to match_indent-never.ml.stdout - (with-stderr-to match_indent-never.ml.stderr - (run %{bin:ocamlformat} --margin-check --match-indent=4 --match-indent-nested=never %{dep:tests/match_indent.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/match_indent-never.ml.ref match_indent-never.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/match_indent-never.ml.err match_indent-never.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to match_indent.ml.stdout - (with-stderr-to match_indent.ml.stderr - (run %{bin:ocamlformat} --margin-check --match-indent=4 --match-indent-nested=always %{dep:tests/match_indent.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/match_indent.ml.ref match_indent.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/match_indent.ml.err match_indent.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to max_indent.ml.stdout - (with-stderr-to max_indent.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-indent=2 %{dep:tests/max_indent.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/max_indent.ml max_indent.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/max_indent.ml.err max_indent.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to mod_type_subst.ml.stdout - (with-stderr-to mod_type_subst.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/mod_type_subst.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/mod_type_subst.ml mod_type_subst.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/mod_type_subst.ml.err mod_type_subst.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to module.ml.stdout - (with-stderr-to module.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/module.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module.ml module.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module.ml.err module.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to module_anonymous.ml.stdout - (with-stderr-to module_anonymous.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/module_anonymous.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module_anonymous.ml module_anonymous.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module_anonymous.ml.err module_anonymous.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to module_attributes.ml.stdout - (with-stderr-to module_attributes.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/module_attributes.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module_attributes.ml.ref module_attributes.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module_attributes.ml.err module_attributes.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to module_item_spacing-preserve.ml.stdout - (with-stderr-to module_item_spacing-preserve.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iter=3 --module-item-spacing=preserve %{dep:tests/module_item_spacing.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module_item_spacing-preserve.ml.ref module_item_spacing-preserve.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module_item_spacing-preserve.ml.err module_item_spacing-preserve.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to module_item_spacing-sparse.ml.stdout - (with-stderr-to module_item_spacing-sparse.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iter=3 --module-item-spacing=sparse %{dep:tests/module_item_spacing.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module_item_spacing-sparse.ml.ref module_item_spacing-sparse.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module_item_spacing-sparse.ml.err module_item_spacing-sparse.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to module_item_spacing.ml.stdout - (with-stderr-to module_item_spacing.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iter=3 --module-item-spacing=compact %{dep:tests/module_item_spacing.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module_item_spacing.ml.ref module_item_spacing.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module_item_spacing.ml.err module_item_spacing.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to module_item_spacing.mli.stdout - (with-stderr-to module_item_spacing.mli.stderr - (run %{bin:ocamlformat} --margin-check --max-iter=3 %{dep:tests/module_item_spacing.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module_item_spacing.mli.ref module_item_spacing.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module_item_spacing.mli.err module_item_spacing.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to module_type.ml.stdout - (with-stderr-to module_type.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/module_type.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module_type.ml module_type.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module_type.ml.err module_type.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to module_type.mli.stdout - (with-stderr-to module_type.mli.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/module_type.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module_type.mli.ref module_type.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/module_type.mli.err module_type.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to monadic_binding.ml.stdout - (with-stderr-to monadic_binding.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/monadic_binding.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/monadic_binding.ml monadic_binding.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/monadic_binding.ml.err monadic_binding.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to multi_index_op.ml.stdout - (with-stderr-to multi_index_op.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/multi_index_op.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/multi_index_op.ml multi_index_op.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/multi_index_op.ml.err multi_index_op.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to named_existentials.ml.stdout - (with-stderr-to named_existentials.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/named_existentials.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/named_existentials.ml named_existentials.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/named_existentials.ml.err named_existentials.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to need_format.ml.stdout - (with-stderr-to need_format.ml.stderr - (with-accepted-exit-codes 1 - (run %{bin:ocamlformat} --margin-check --max-iters=1 %{dep:tests/need_format.ml})))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/need_format.ml.ref need_format.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/need_format.ml.err need_format.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to new.ml.stdout - (with-stderr-to new.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/new.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/new.ml new.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/new.ml.err new.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to object.ml.stdout - (with-stderr-to object.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/object.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/object.ml.ref object.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/object.ml.err object.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to object2.ml.stdout - (with-stderr-to object2.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/object2.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/object2.ml.ref object2.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/object2.ml.err object2.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to object_expr-414.ml.stdout - (with-stderr-to object_expr-414.ml.stderr - (run %{bin:ocamlformat} --margin-check --ocaml-version=4.14.0 %{dep:tests/object_expr.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/object_expr-414.ml.ref object_expr-414.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/object_expr-414.ml.err object_expr-414.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to object_expr.ml.stdout - (with-stderr-to object_expr.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/object_expr.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/object_expr.ml.ref object_expr.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/object_expr.ml.err object_expr.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to object_type.ml.stdout - (with-stderr-to object_type.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/object_type.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/object_type.ml.ref object_type.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/object_type.ml.err object_type.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to obuild.ml.stdout - (with-stderr-to obuild.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/obuild.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/obuild.ml.ref obuild.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/obuild.ml.err obuild.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ocp_indent_compat-break_colon_after.ml.stdout - (with-stderr-to ocp_indent_compat-break_colon_after.ml.stderr - (run %{bin:ocamlformat} --margin-check --ocp-indent-compat --break-colon=after %{dep:tests/ocp_indent_compat.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ocp_indent_compat-break_colon_after.ml.ref ocp_indent_compat-break_colon_after.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ocp_indent_compat-break_colon_after.ml.err ocp_indent_compat-break_colon_after.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ocp_indent_compat.ml.stdout - (with-stderr-to ocp_indent_compat.ml.stderr - (run %{bin:ocamlformat} --margin-check --ocp-indent-compat --break-colon=before %{dep:tests/ocp_indent_compat.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ocp_indent_compat.ml ocp_indent_compat.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ocp_indent_compat.ml.err ocp_indent_compat.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to ocp_indent_options.ml.stdout - (with-stderr-to ocp_indent_options.ml.stderr - (run %{bin:ocamlformat} --margin-check --ocp-indent-config %{dep:tests/ocp_indent_options.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ocp_indent_options.ml.ref ocp_indent_options.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/ocp_indent_options.ml.err ocp_indent_options.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to open-closing-on-separate-line.ml.stdout - (with-stderr-to open-closing-on-separate-line.ml.stderr - (run %{bin:ocamlformat} --margin-check --indicate-multiline-delimiters=closing-on-separate-line %{dep:tests/open.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/open-closing-on-separate-line.ml.ref open-closing-on-separate-line.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/open-closing-on-separate-line.ml.err open-closing-on-separate-line.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to open.ml.stdout - (with-stderr-to open.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/open.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/open.ml.ref open.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/open.ml.err open.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to open_types.ml.stdout - (with-stderr-to open_types.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/open_types.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/open_types.ml open_types.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/open_types.ml.err open_types.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to option.ml.stdout - (with-stderr-to option.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/option.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/option.ml.ref option.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/option.ml.err option.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to override.ml.stdout - (with-stderr-to override.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/override.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/override.ml.ref override.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/override.ml.err override.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to parens_tuple_patterns.ml.stdout - (with-stderr-to parens_tuple_patterns.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/parens_tuple_patterns.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/parens_tuple_patterns.ml parens_tuple_patterns.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/parens_tuple_patterns.ml.err parens_tuple_patterns.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to polytypes-default.ml.stdout - (with-stderr-to polytypes-default.ml.stderr - (run %{bin:ocamlformat} --margin-check --profile=default %{dep:tests/polytypes.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/polytypes-default.ml.ref polytypes-default.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/polytypes-default.ml.err polytypes-default.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to polytypes-janestreet.ml.stdout - (with-stderr-to polytypes-janestreet.ml.stderr - (run %{bin:ocamlformat} --margin-check --profile=janestreet %{dep:tests/polytypes.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/polytypes-janestreet.ml.ref polytypes-janestreet.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/polytypes-janestreet.ml.err polytypes-janestreet.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to polytypes.ml.stdout - (with-stderr-to polytypes.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/polytypes.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/polytypes.ml polytypes.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/polytypes.ml.err polytypes.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to pre_post_extensions.ml.stdout - (with-stderr-to pre_post_extensions.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/pre_post_extensions.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/pre_post_extensions.ml pre_post_extensions.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/pre_post_extensions.ml.err pre_post_extensions.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to precedence.ml.stdout - (with-stderr-to precedence.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/precedence.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/precedence.ml precedence.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/precedence.ml.err precedence.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to prefix_infix.ml.stdout - (with-stderr-to prefix_infix.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/prefix_infix.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/prefix_infix.ml prefix_infix.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/prefix_infix.ml.err prefix_infix.ml.stderr))) - -(rule - (deps tests/.ocamlformat tests/dir1/dir2/.ocamlformat tests/dir1/dir2/print_config.ml) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to print_config.ml.stdout - (with-stderr-to print_config.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/dir1/dir2/print_config.ml} --print-config --config=max-iters=2 %{dep:tests/print_config.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/print_config.ml.ref print_config.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/print_config.ml.err print_config.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to profiles.ml.stdout - (with-stderr-to profiles.ml.stderr - (run %{bin:ocamlformat} --margin-check --config=margin=20 --profile=janestreet --module-item-spacing=sparse %{dep:tests/profiles.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/profiles.ml profiles.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/profiles.ml.err profiles.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to profiles2.ml.stdout - (with-stderr-to profiles2.ml.stderr - (run %{bin:ocamlformat} --margin-check --profile=janestreet %{dep:tests/profiles2.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/profiles2.ml profiles2.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/profiles2.ml.err profiles2.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to protected_object_types.ml.stdout - (with-stderr-to protected_object_types.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/protected_object_types.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/protected_object_types.ml protected_object_types.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/protected_object_types.ml.err protected_object_types.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to qtest.ml.stdout - (with-stderr-to qtest.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/qtest.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/qtest.ml qtest.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/qtest.ml.err qtest.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to quoted_strings.ml.stdout - (with-stderr-to quoted_strings.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/quoted_strings.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/quoted_strings.ml quoted_strings.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/quoted_strings.ml.err quoted_strings.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to recmod.mli.stdout - (with-stderr-to recmod.mli.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/recmod.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/recmod.mli recmod.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/recmod.mli.err recmod.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to record-402.ml.stdout - (with-stderr-to record-402.ml.stderr - (run %{bin:ocamlformat} --margin-check --ocaml-version=4.02 %{dep:tests/record.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/record-402.ml.ref record-402.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/record-402.ml.err record-402.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to record-default.ml.stdout - (with-stderr-to record-default.ml.stderr - (run %{bin:ocamlformat} --margin-check --profile=default --max-iter=3 %{dep:tests/record.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/record-default.ml.ref record-default.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/record-default.ml.err record-default.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to record-loose.ml.stdout - (with-stderr-to record-loose.ml.stderr - (run %{bin:ocamlformat} --margin-check --field-space=loose %{dep:tests/record.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/record-loose.ml.ref record-loose.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/record-loose.ml.err record-loose.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to record-tight_decl.ml.stdout - (with-stderr-to record-tight_decl.ml.stderr - (run %{bin:ocamlformat} --margin-check --field-space=tight-decl %{dep:tests/record.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/record-tight_decl.ml.ref record-tight_decl.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/record-tight_decl.ml.err record-tight_decl.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to record.ml.stdout - (with-stderr-to record.ml.stderr - (run %{bin:ocamlformat} --margin-check --field-space=tight %{dep:tests/record.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/record.ml.ref record.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/record.ml.err record.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to record_punning-js.ml.stdout - (with-stderr-to record_punning-js.ml.stderr - (run %{bin:ocamlformat} --margin-check --profile=janestreet --max-iter=4 %{dep:tests/record_punning.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/record_punning-js.ml.ref record_punning-js.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/record_punning-js.ml.err record_punning-js.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to record_punning.ml.stdout - (with-stderr-to record_punning.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/record_punning.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/record_punning.ml.ref record_punning.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/record_punning.ml.err record_punning.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to reformat_string.ml.stdout - (with-stderr-to reformat_string.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iter=2 %{dep:tests/reformat_string.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/reformat_string.ml.ref reformat_string.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/reformat_string.ml.err reformat_string.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to refs.ml.stdout - (with-stderr-to refs.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/refs.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/refs.ml refs.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/refs.ml.err refs.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to remove_extra_parens.ml.stdout - (with-stderr-to remove_extra_parens.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/remove_extra_parens.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/remove_extra_parens.ml.ref remove_extra_parens.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/remove_extra_parens.ml.err remove_extra_parens.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to repl.ml.stdout - (with-stderr-to repl.ml.stderr - (run %{bin:ocamlformat} --margin-check --parse-toplevel-phrases --repl-file %{dep:tests/repl.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/repl.ml.ref repl.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/repl.ml.err repl.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to repl.mli.stdout - (with-stderr-to repl.mli.stderr - (run %{bin:ocamlformat} --margin-check --parse-toplevel-phrases %{dep:tests/repl.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/repl.mli.ref repl.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/repl.mli.err repl.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to revapply_ext.ml.stdout - (with-stderr-to revapply_ext.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/revapply_ext.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/revapply_ext.ml revapply_ext.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/revapply_ext.ml.err revapply_ext.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to send.ml.stdout - (with-stderr-to send.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/send.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/send.ml send.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/send.ml.err send.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to sequence-preserve.ml.stdout - (with-stderr-to sequence-preserve.ml.stderr - (run %{bin:ocamlformat} --margin-check --sequence-blank-line=preserve-one --max-iter=3 %{dep:tests/sequence.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/sequence-preserve.ml.ref sequence-preserve.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/sequence-preserve.ml.err sequence-preserve.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to sequence.ml.stdout - (with-stderr-to sequence.ml.stderr - (run %{bin:ocamlformat} --margin-check --sequence-blank-line=compact %{dep:tests/sequence.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/sequence.ml.ref sequence.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/sequence.ml.err sequence.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to shebang.ml.stdout - (with-stderr-to shebang.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/shebang.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/shebang.ml shebang.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/shebang.ml.err shebang.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to shortcut_ext_attr.ml.stdout - (with-stderr-to shortcut_ext_attr.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/shortcut_ext_attr.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/shortcut_ext_attr.ml shortcut_ext_attr.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/shortcut_ext_attr.ml.err shortcut_ext_attr.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to sig_value.mli.stdout - (with-stderr-to sig_value.mli.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/sig_value.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/sig_value.mli.ref sig_value.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/sig_value.mli.err sig_value.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to single_line.mli.stdout - (with-stderr-to single_line.mli.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/single_line.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/single_line.mli single_line.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/single_line.mli.err single_line.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to skip.ml.stdout - (with-stderr-to skip.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/skip.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/skip.ml skip.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/skip.ml.err skip.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to source-conventional.ml.stdout - (with-stderr-to source-conventional.ml.stderr - (run %{bin:ocamlformat} --margin-check --profile=default --max-iters=3 %{dep:tests/source.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/source-conventional.ml.ref source-conventional.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/source-conventional.ml.err source-conventional.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to source.ml.stdout - (with-stderr-to source.ml.stderr - (run %{bin:ocamlformat} --margin-check --max-iters=3 %{dep:tests/source.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/source.ml.ref source.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/source.ml.err source.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to str_value.ml.stdout - (with-stderr-to str_value.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/str_value.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/str_value.ml str_value.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/str_value.ml.err str_value.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to string.ml.stdout - (with-stderr-to string.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/string.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/string.ml.ref string.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/string.ml.err string.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to string_array.ml.stdout - (with-stderr-to string_array.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/string_array.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/string_array.ml string_array.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/string_array.ml.err string_array.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to string_wrapping.ml.stdout - (with-stderr-to string_wrapping.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/string_wrapping.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/string_wrapping.ml string_wrapping.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/string_wrapping.ml.err string_wrapping.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to symbol.ml.stdout - (with-stderr-to symbol.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/symbol.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/symbol.ml symbol.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/symbol.ml.err symbol.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to tag_only.ml.stdout - (with-stderr-to tag_only.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/tag_only.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/tag_only.ml tag_only.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/tag_only.ml.err tag_only.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to tag_only.mli.stdout - (with-stderr-to tag_only.mli.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/tag_only.mli}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/tag_only.mli tag_only.mli.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/tag_only.mli.err tag_only.mli.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to try_with_or_pattern.ml.stdout - (with-stderr-to try_with_or_pattern.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/try_with_or_pattern.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/try_with_or_pattern.ml try_with_or_pattern.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/try_with_or_pattern.ml.err try_with_or_pattern.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to tuple.ml.stdout - (with-stderr-to tuple.ml.stderr - (run %{bin:ocamlformat} --margin-check --parens-tuple=always %{dep:tests/tuple.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/tuple.ml tuple.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/tuple.ml.err tuple.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to tuple_less_parens.ml.stdout - (with-stderr-to tuple_less_parens.ml.stderr - (run %{bin:ocamlformat} --margin-check --parens-tuple=multi-line-only %{dep:tests/tuple_less_parens.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/tuple_less_parens.ml tuple_less_parens.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/tuple_less_parens.ml.err tuple_less_parens.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to tuple_type_parens.ml.stdout - (with-stderr-to tuple_type_parens.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/tuple_type_parens.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/tuple_type_parens.ml tuple_type_parens.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/tuple_type_parens.ml.err tuple_type_parens.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to type_and_constraint.ml.stdout - (with-stderr-to type_and_constraint.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/type_and_constraint.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/type_and_constraint.ml type_and_constraint.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/type_and_constraint.ml.err type_and_constraint.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to type_annotations.ml.stdout - (with-stderr-to type_annotations.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/type_annotations.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/type_annotations.ml type_annotations.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/type_annotations.ml.err type_annotations.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to types-compact-space_around-docked.ml.stdout - (with-stderr-to types-compact-space_around-docked.ml.stderr - (run %{bin:ocamlformat} --margin-check --type-decl=compact --space-around-arrays --space-around-lists --space-around-records --space-around-variants --break-separators=after --dock-collection-brackets %{dep:tests/types.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/types-compact-space_around-docked.ml.ref types-compact-space_around-docked.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/types-compact-space_around-docked.ml.err types-compact-space_around-docked.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to types-compact-space_around.ml.stdout - (with-stderr-to types-compact-space_around.ml.stderr - (run %{bin:ocamlformat} --margin-check --type-decl=compact --space-around-arrays --space-around-lists --space-around-records --space-around-variants %{dep:tests/types.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/types-compact-space_around.ml.ref types-compact-space_around.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/types-compact-space_around.ml.err types-compact-space_around.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to types-compact.ml.stdout - (with-stderr-to types-compact.ml.stderr - (run %{bin:ocamlformat} --margin-check --type-decl=compact %{dep:tests/types.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/types-compact.ml.ref types-compact.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/types-compact.ml.err types-compact.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to types-indent.ml.stdout - (with-stderr-to types-indent.ml.stderr - (run %{bin:ocamlformat} --margin-check --type-decl-indent=6 %{dep:tests/types.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/types-indent.ml.ref types-indent.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/types-indent.ml.err types-indent.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to types-sparse-space_around.ml.stdout - (with-stderr-to types-sparse-space_around.ml.stderr - (run %{bin:ocamlformat} --margin-check --type-decl=sparse --space-around-arrays --space-around-lists --space-around-records --space-around-variants %{dep:tests/types.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/types-sparse-space_around.ml.ref types-sparse-space_around.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/types-sparse-space_around.ml.err types-sparse-space_around.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to types-sparse.ml.stdout - (with-stderr-to types-sparse.ml.stderr - (run %{bin:ocamlformat} --margin-check --type-decl=sparse %{dep:tests/types.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/types-sparse.ml.ref types-sparse.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/types-sparse.ml.err types-sparse.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to types.ml.stdout - (with-stderr-to types.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/types.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/types.ml types.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/types.ml.err types.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to unary.ml.stdout - (with-stderr-to unary.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/unary.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/unary.ml.ref unary.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/unary.ml.err unary.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to unary_hash.ml.stdout - (with-stderr-to unary_hash.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/unary_hash.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/unary_hash.ml unary_hash.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/unary_hash.ml.err unary_hash.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to unicode.ml.stdout - (with-stderr-to unicode.ml.stderr - (run %{bin:ocamlformat} --margin-check --margin=80 --wrap-comments %{dep:tests/unicode.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/unicode.ml.ref unicode.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/unicode.ml.err unicode.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to use_file.mlt.stdout - (with-stderr-to use_file.mlt.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/use_file.mlt}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/use_file.mlt use_file.mlt.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/use_file.mlt.err use_file.mlt.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to variants.ml.stdout - (with-stderr-to variants.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/variants.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/variants.ml variants.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/variants.ml.err variants.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to verbatim_comments-wrap.ml.stdout - (with-stderr-to verbatim_comments-wrap.ml.stderr - (run %{bin:ocamlformat} --margin-check --wrap-comments %{dep:tests/verbatim_comments.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/verbatim_comments-wrap.ml.ref verbatim_comments-wrap.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/verbatim_comments-wrap.ml.err verbatim_comments-wrap.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to verbatim_comments.ml.stdout - (with-stderr-to verbatim_comments.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/verbatim_comments.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/verbatim_comments.ml.ref verbatim_comments.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/verbatim_comments.ml.err verbatim_comments.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to verbose1.ml.stdout - (with-stderr-to verbose1.ml.stderr - (run %{bin:ocamlformat} --margin-check --print-config --doc-comments=before --config=doc-comments=before %{dep:tests/verbose1.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/verbose1.ml.ref verbose1.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/verbose1.ml.err verbose1.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to w50.ml.stdout - (with-stderr-to w50.ml.stderr - (run %{bin:ocamlformat} --margin-check --no-comment-check -q --max-iters=3 %{dep:tests/w50.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/w50.ml.ref w50.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/w50.ml.err w50.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action - (with-stdout-to wrap_comments.ml.stdout - (with-stderr-to wrap_comments.ml.stderr - (run %{bin:ocamlformat} --margin-check --profile=ocamlformat --max-iters=3 %{dep:tests/wrap_comments.ml}))))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/wrap_comments.ml.ref wrap_comments.ml.stdout))) - -(rule - (alias runtest) - (enabled_if (<> %{os_type} Win32)) - (package ocamlformat) - (action (diff tests/wrap_comments.ml.err wrap_comments.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to wrap_comments_break.ml.stdout - (with-stderr-to wrap_comments_break.ml.stderr - (run %{bin:ocamlformat} --margin-check --no-wrap-fun-args --margin=67 %{dep:tests/wrap_comments_break.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/wrap_comments_break.ml wrap_comments_break.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/wrap_comments_break.ml.err wrap_comments_break.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to wrap_invalid_doc_comments.ml.stdout - (with-stderr-to wrap_invalid_doc_comments.ml.stderr - (run %{bin:ocamlformat} --margin-check --parse-docstrings --wrap-comments %{dep:tests/wrap_invalid_doc_comments.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/wrap_invalid_doc_comments.ml wrap_invalid_doc_comments.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/wrap_invalid_doc_comments.ml.err wrap_invalid_doc_comments.ml.stderr))) - -(rule - (deps tests/.ocamlformat ) - (package ocamlformat) - (action - (with-stdout-to wrapping_functor_args.ml.stdout - (with-stderr-to wrapping_functor_args.ml.stderr - (run %{bin:ocamlformat} --margin-check %{dep:tests/wrapping_functor_args.ml}))))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/wrapping_functor_args.ml wrapping_functor_args.ml.stdout))) - -(rule - (alias runtest) - (package ocamlformat) - (action (diff tests/wrapping_functor_args.ml.err wrapping_functor_args.ml.stderr))) diff --git a/test/passing/gen/dune b/test/passing/gen/dune index 9df6b5100e..7aa5a813d6 100644 --- a/test/passing/gen/dune +++ b/test/passing/gen/dune @@ -1,2 +1,21 @@ (executable (name gen)) + +(rule + (deps + (source_tree ../tests)) + (package ocamlformat) + (enabled_if + (<> %{os_type} Win32)) + (action + (with-stdout-to + dune.inc.gen + (run ../gen/gen.exe)))) + +(rule + (alias runtest) + (package ocamlformat) + (enabled_if + (<> %{os_type} Win32)) + (action + (diff dune.inc dune.inc.gen))) diff --git a/test/passing/gen/dune.inc b/test/passing/gen/dune.inc new file mode 100644 index 0000000000..fe9469a4ae --- /dev/null +++ b/test/passing/gen/dune.inc @@ -0,0 +1,4634 @@ + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to align_infix.ml.stdout + (with-stderr-to align_infix.ml.stderr + (run %{bin:ocamlformat} --name align_infix.ml --margin-check --break-infix=fit-or-vertical %{dep:../tests/align_infix.ml}))))) + +(rule + (alias runtest) + (action (diff align_infix.ml.ref align_infix.ml.stdout))) + +(rule + (alias runtest) + (action (diff align_infix.ml.err align_infix.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to alignment.ml.stdout + (with-stderr-to alignment.ml.stderr + (run %{bin:ocamlformat} --name alignment.ml --margin-check %{dep:../tests/alignment.ml}))))) + +(rule + (alias runtest) + (action (diff alignment.ml.ref alignment.ml.stdout))) + +(rule + (alias runtest) + (action (diff alignment.ml.err alignment.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to apply.ml.stdout + (with-stderr-to apply.ml.stderr + (run %{bin:ocamlformat} --name apply.ml --margin-check %{dep:../tests/apply.ml}))))) + +(rule + (alias runtest) + (action (diff apply.ml.ref apply.ml.stdout))) + +(rule + (alias runtest) + (action (diff apply.ml.err apply.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to apply_functor.ml.stdout + (with-stderr-to apply_functor.ml.stderr + (run %{bin:ocamlformat} --name apply_functor.ml --margin-check %{dep:../tests/apply_functor.ml}))))) + +(rule + (alias runtest) + (action (diff apply_functor.ml.ref apply_functor.ml.stdout))) + +(rule + (alias runtest) + (action (diff apply_functor.ml.err apply_functor.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to args_grouped.ml.stdout + (with-stderr-to args_grouped.ml.stderr + (run %{bin:ocamlformat} --name args_grouped.ml --margin-check --margin=100 %{dep:../tests/args_grouped.ml}))))) + +(rule + (alias runtest) + (action (diff args_grouped.ml.ref args_grouped.ml.stdout))) + +(rule + (alias runtest) + (action (diff args_grouped.ml.err args_grouped.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to array.ml.stdout + (with-stderr-to array.ml.stderr + (run %{bin:ocamlformat} --name array.ml --margin-check %{dep:../tests/array.ml}))))) + +(rule + (alias runtest) + (action (diff array.ml.ref array.ml.stdout))) + +(rule + (alias runtest) + (action (diff array.ml.err array.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to assignment_operator-op_begin_line.ml.stdout + (with-stderr-to assignment_operator-op_begin_line.ml.stderr + (run %{bin:ocamlformat} --name assignment_operator-op_begin_line.ml --margin-check --assignment-operator=begin-line %{dep:../tests/assignment_operator.ml}))))) + +(rule + (alias runtest) + (action (diff assignment_operator-op_begin_line.ml.ref assignment_operator-op_begin_line.ml.stdout))) + +(rule + (alias runtest) + (action (diff assignment_operator-op_begin_line.ml.err assignment_operator-op_begin_line.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to assignment_operator.ml.stdout + (with-stderr-to assignment_operator.ml.stderr + (run %{bin:ocamlformat} --name assignment_operator.ml --margin-check %{dep:../tests/assignment_operator.ml}))))) + +(rule + (alias runtest) + (action (diff assignment_operator.ml.ref assignment_operator.ml.stdout))) + +(rule + (alias runtest) + (action (diff assignment_operator.ml.err assignment_operator.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to attribute_and_expression.ml.stdout + (with-stderr-to attribute_and_expression.ml.stderr + (run %{bin:ocamlformat} --name attribute_and_expression.ml --margin-check %{dep:../tests/attribute_and_expression.ml}))))) + +(rule + (alias runtest) + (action (diff attribute_and_expression.ml.ref attribute_and_expression.ml.stdout))) + +(rule + (alias runtest) + (action (diff attribute_and_expression.ml.err attribute_and_expression.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to attributes.ml.stdout + (with-stderr-to attributes.ml.stderr + (run %{bin:ocamlformat} --name attributes.ml --margin-check %{dep:../tests/attributes.ml}))))) + +(rule + (alias runtest) + (action (diff attributes.ml.ref attributes.ml.stdout))) + +(rule + (alias runtest) + (action (diff attributes.ml.err attributes.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to attributes.mli.stdout + (with-stderr-to attributes.mli.stderr + (run %{bin:ocamlformat} --name attributes.mli --margin-check %{dep:../tests/attributes.mli}))))) + +(rule + (alias runtest) + (action (diff attributes.mli.ref attributes.mli.stdout))) + +(rule + (alias runtest) + (action (diff attributes.mli.err attributes.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to binders.ml.stdout + (with-stderr-to binders.ml.stderr + (run %{bin:ocamlformat} --name binders.ml --margin-check %{dep:../tests/binders.ml}))))) + +(rule + (alias runtest) + (action (diff binders.ml.ref binders.ml.stdout))) + +(rule + (alias runtest) + (action (diff binders.ml.err binders.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_before_in-auto.ml.stdout + (with-stderr-to break_before_in-auto.ml.stderr + (run %{bin:ocamlformat} --name break_before_in-auto.ml --margin-check --break-before-in=auto %{dep:../tests/break_before_in.ml}))))) + +(rule + (alias runtest) + (action (diff break_before_in-auto.ml.ref break_before_in-auto.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_before_in-auto.ml.err break_before_in-auto.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_before_in.ml.stdout + (with-stderr-to break_before_in.ml.stderr + (run %{bin:ocamlformat} --name break_before_in.ml --margin-check --break-before-in=fit-or-vertical %{dep:../tests/break_before_in.ml}))))) + +(rule + (alias runtest) + (action (diff break_before_in.ml.ref break_before_in.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_before_in.ml.err break_before_in.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to break_cases-align.ml.stdout + (with-stderr-to break_cases-align.ml.stderr + (run %{bin:ocamlformat} --name break_cases-align.ml --margin-check --nested-match=align --break-cases=all %{dep:../tests/break_cases.ml}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-align.ml.ref break_cases-align.ml.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-align.ml.err break_cases-align.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to break_cases-all.ml.stdout + (with-stderr-to break_cases-all.ml.stderr + (run %{bin:ocamlformat} --name break_cases-all.ml --margin-check --break-cases=all %{dep:../tests/break_cases.ml}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-all.ml.ref break_cases-all.ml.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-all.ml.err break_cases-all.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to break_cases-closing_on_separate_line.ml.stdout + (with-stderr-to break_cases-closing_on_separate_line.ml.stderr + (run %{bin:ocamlformat} --name break_cases-closing_on_separate_line.ml --margin-check --break-cases=all --indicate-multiline-delimiters=closing-on-separate-line %{dep:../tests/break_cases.ml}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-closing_on_separate_line.ml.ref break_cases-closing_on_separate_line.ml.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-closing_on_separate_line.ml.err break_cases-closing_on_separate_line.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_cases-closing_on_separate_line_fit_or_vertical.ml.stdout + (with-stderr-to break_cases-closing_on_separate_line_fit_or_vertical.ml.stderr + (run %{bin:ocamlformat} --name break_cases-closing_on_separate_line_fit_or_vertical.ml --margin-check --break-cases=fit-or-vertical --indicate-multiline-delimiters=closing-on-separate-line %{dep:../tests/break_cases.ml}))))) + +(rule + (alias runtest) + (action (diff break_cases-closing_on_separate_line_fit_or_vertical.ml.ref break_cases-closing_on_separate_line_fit_or_vertical.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_cases-closing_on_separate_line_fit_or_vertical.ml.err break_cases-closing_on_separate_line_fit_or_vertical.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to break_cases-closing_on_separate_line_leading_nested_match_parens.ml.stdout + (with-stderr-to break_cases-closing_on_separate_line_leading_nested_match_parens.ml.stderr + (run %{bin:ocamlformat} --name break_cases-closing_on_separate_line_leading_nested_match_parens.ml --margin-check --break-cases=all --indicate-multiline-delimiters=closing-on-separate-line --leading-nested-match-parens %{dep:../tests/break_cases.ml}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref break_cases-closing_on_separate_line_leading_nested_match_parens.ml.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err break_cases-closing_on_separate_line_leading_nested_match_parens.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to break_cases-cosl_lnmp_cmei.ml.stdout + (with-stderr-to break_cases-cosl_lnmp_cmei.ml.stderr + (run %{bin:ocamlformat} --name break_cases-cosl_lnmp_cmei.ml --margin-check --break-cases=all --indicate-multiline-delimiters=closing-on-separate-line --leading-nested-match-parens --cases-matching-exp-indent=normal %{dep:../tests/break_cases.ml}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-cosl_lnmp_cmei.ml.ref break_cases-cosl_lnmp_cmei.ml.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-cosl_lnmp_cmei.ml.err break_cases-cosl_lnmp_cmei.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to break_cases-fit_or_vertical.ml.stdout + (with-stderr-to break_cases-fit_or_vertical.ml.stderr + (run %{bin:ocamlformat} --name break_cases-fit_or_vertical.ml --margin-check --break-cases=fit-or-vertical %{dep:../tests/break_cases.ml}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-fit_or_vertical.ml.ref break_cases-fit_or_vertical.ml.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-fit_or_vertical.ml.err break_cases-fit_or_vertical.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to break_cases-nested.ml.stdout + (with-stderr-to break_cases-nested.ml.stderr + (run %{bin:ocamlformat} --name break_cases-nested.ml --margin-check --break-cases=nested %{dep:../tests/break_cases.ml}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-nested.ml.ref break_cases-nested.ml.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-nested.ml.err break_cases-nested.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to break_cases-normal_indent.ml.stdout + (with-stderr-to break_cases-normal_indent.ml.stderr + (run %{bin:ocamlformat} --name break_cases-normal_indent.ml --margin-check --cases-matching-exp-indent=normal --break-cases=all %{dep:../tests/break_cases.ml}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-normal_indent.ml.ref break_cases-normal_indent.ml.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-normal_indent.ml.err break_cases-normal_indent.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_cases-toplevel.ml.stdout + (with-stderr-to break_cases-toplevel.ml.stderr + (run %{bin:ocamlformat} --name break_cases-toplevel.ml --margin-check --break-cases=toplevel --max-iter=4 %{dep:../tests/break_cases.ml}))))) + +(rule + (alias runtest) + (action (diff break_cases-toplevel.ml.ref break_cases-toplevel.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_cases-toplevel.ml.err break_cases-toplevel.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to break_cases-vertical.ml.stdout + (with-stderr-to break_cases-vertical.ml.stderr + (run %{bin:ocamlformat} --name break_cases-vertical.ml --margin-check --break-cases=vertical %{dep:../tests/break_cases.ml}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-vertical.ml.ref break_cases-vertical.ml.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff break_cases-vertical.ml.err break_cases-vertical.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_cases.ml.stdout + (with-stderr-to break_cases.ml.stderr + (run %{bin:ocamlformat} --name break_cases.ml --margin-check --break-cases=fit --max-iter=4 %{dep:../tests/break_cases.ml}))))) + +(rule + (alias runtest) + (action (diff break_cases.ml.ref break_cases.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_cases.ml.err break_cases.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_collection_expressions-wrap.ml.stdout + (with-stderr-to break_collection_expressions-wrap.ml.stderr + (run %{bin:ocamlformat} --name break_collection_expressions-wrap.ml --margin-check --break-collection-expressions=wrap --max-iters=3 %{dep:../tests/break_collection_expressions.ml}))))) + +(rule + (alias runtest) + (action (diff break_collection_expressions-wrap.ml.ref break_collection_expressions-wrap.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_collection_expressions-wrap.ml.err break_collection_expressions-wrap.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_collection_expressions.ml.stdout + (with-stderr-to break_collection_expressions.ml.stderr + (run %{bin:ocamlformat} --name break_collection_expressions.ml --margin-check --break-collection-expressions=fit-or-vertical --max-iters=3 %{dep:../tests/break_collection_expressions.ml}))))) + +(rule + (alias runtest) + (action (diff break_collection_expressions.ml.ref break_collection_expressions.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_collection_expressions.ml.err break_collection_expressions.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_colon-before.ml.stdout + (with-stderr-to break_colon-before.ml.stderr + (run %{bin:ocamlformat} --name break_colon-before.ml --margin-check --break-colon=before %{dep:../tests/break_colon.ml}))))) + +(rule + (alias runtest) + (action (diff break_colon-before.ml.ref break_colon-before.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_colon-before.ml.err break_colon-before.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_colon.ml.stdout + (with-stderr-to break_colon.ml.stderr + (run %{bin:ocamlformat} --name break_colon.ml --margin-check --break-colon=after %{dep:../tests/break_colon.ml}))))) + +(rule + (alias runtest) + (action (diff break_colon.ml.ref break_colon.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_colon.ml.err break_colon.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_fun_decl-fit_or_vertical.ml.stdout + (with-stderr-to break_fun_decl-fit_or_vertical.ml.stderr + (run %{bin:ocamlformat} --name break_fun_decl-fit_or_vertical.ml --margin-check --break-fun-decl=fit-or-vertical --break-fun-sig=fit-or-vertical %{dep:../tests/break_fun_decl.ml}))))) + +(rule + (alias runtest) + (action (diff break_fun_decl-fit_or_vertical.ml.ref break_fun_decl-fit_or_vertical.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_fun_decl-fit_or_vertical.ml.err break_fun_decl-fit_or_vertical.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_fun_decl-smart.ml.stdout + (with-stderr-to break_fun_decl-smart.ml.stderr + (run %{bin:ocamlformat} --name break_fun_decl-smart.ml --margin-check --break-fun-decl=smart --break-fun-sig=smart %{dep:../tests/break_fun_decl.ml}))))) + +(rule + (alias runtest) + (action (diff break_fun_decl-smart.ml.ref break_fun_decl-smart.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_fun_decl-smart.ml.err break_fun_decl-smart.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_fun_decl-wrap.ml.stdout + (with-stderr-to break_fun_decl-wrap.ml.stderr + (run %{bin:ocamlformat} --name break_fun_decl-wrap.ml --margin-check --break-fun-decl=wrap --break-fun-sig=wrap %{dep:../tests/break_fun_decl.ml}))))) + +(rule + (alias runtest) + (action (diff break_fun_decl-wrap.ml.ref break_fun_decl-wrap.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_fun_decl-wrap.ml.err break_fun_decl-wrap.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_fun_decl.ml.stdout + (with-stderr-to break_fun_decl.ml.stderr + (run %{bin:ocamlformat} --name break_fun_decl.ml --margin-check %{dep:../tests/break_fun_decl.ml}))))) + +(rule + (alias runtest) + (action (diff break_fun_decl.ml.ref break_fun_decl.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_fun_decl.ml.err break_fun_decl.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_infix-fit-or-vertical.ml.stdout + (with-stderr-to break_infix-fit-or-vertical.ml.stderr + (run %{bin:ocamlformat} --name break_infix-fit-or-vertical.ml --margin-check --break-infix=fit-or-vertical %{dep:../tests/break_infix.ml}))))) + +(rule + (alias runtest) + (action (diff break_infix-fit-or-vertical.ml.ref break_infix-fit-or-vertical.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_infix-fit-or-vertical.ml.err break_infix-fit-or-vertical.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_infix-wrap.ml.stdout + (with-stderr-to break_infix-wrap.ml.stderr + (run %{bin:ocamlformat} --name break_infix-wrap.ml --margin-check --break-infix=wrap %{dep:../tests/break_infix.ml}))))) + +(rule + (alias runtest) + (action (diff break_infix-wrap.ml.ref break_infix-wrap.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_infix-wrap.ml.err break_infix-wrap.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_infix.ml.stdout + (with-stderr-to break_infix.ml.stderr + (run %{bin:ocamlformat} --name break_infix.ml --margin-check --break-infix=wrap-or-vertical %{dep:../tests/break_infix.ml}))))) + +(rule + (alias runtest) + (action (diff break_infix.ml.ref break_infix.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_infix.ml.err break_infix.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_record.ml.stdout + (with-stderr-to break_record.ml.stderr + (run %{bin:ocamlformat} --name break_record.ml --margin-check --margin=58 %{dep:../tests/break_record.ml}))))) + +(rule + (alias runtest) + (action (diff break_record.ml.ref break_record.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_record.ml.err break_record.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_separators-after.ml.stdout + (with-stderr-to break_separators-after.ml.stderr + (run %{bin:ocamlformat} --name break_separators-after.ml --margin-check --break-separators=after --max-iter=3 %{dep:../tests/break_separators.ml}))))) + +(rule + (alias runtest) + (action (diff break_separators-after.ml.ref break_separators-after.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_separators-after.ml.err break_separators-after.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_separators-after_docked.ml.stdout + (with-stderr-to break_separators-after_docked.ml.stderr + (run %{bin:ocamlformat} --name break_separators-after_docked.ml --margin-check --break-separators=after --dock-collection-brackets --max-iter=3 %{dep:../tests/break_separators.ml}))))) + +(rule + (alias runtest) + (action (diff break_separators-after_docked.ml.ref break_separators-after_docked.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_separators-after_docked.ml.err break_separators-after_docked.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_separators-before_docked.ml.stdout + (with-stderr-to break_separators-before_docked.ml.stderr + (run %{bin:ocamlformat} --name break_separators-before_docked.ml --margin-check --break-separators=before --dock-collection-brackets --max-iter=3 %{dep:../tests/break_separators.ml}))))) + +(rule + (alias runtest) + (action (diff break_separators-before_docked.ml.ref break_separators-before_docked.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_separators-before_docked.ml.err break_separators-before_docked.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_separators.ml.stdout + (with-stderr-to break_separators.ml.stderr + (run %{bin:ocamlformat} --name break_separators.ml --margin-check --break-separators=before --max-iter=3 %{dep:../tests/break_separators.ml}))))) + +(rule + (alias runtest) + (action (diff break_separators.ml.ref break_separators.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_separators.ml.err break_separators.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_sequence_before.ml.stdout + (with-stderr-to break_sequence_before.ml.stderr + (run %{bin:ocamlformat} --name break_sequence_before.ml --margin-check %{dep:../tests/break_sequence_before.ml}))))) + +(rule + (alias runtest) + (action (diff break_sequence_before.ml.ref break_sequence_before.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_sequence_before.ml.err break_sequence_before.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_string_literals-never.ml.stdout + (with-stderr-to break_string_literals-never.ml.stderr + (run %{bin:ocamlformat} --name break_string_literals-never.ml --margin-check --break-string-literals=never %{dep:../tests/break_string_literals.ml}))))) + +(rule + (alias runtest) + (action (diff break_string_literals-never.ml.ref break_string_literals-never.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_string_literals-never.ml.err break_string_literals-never.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_string_literals.ml.stdout + (with-stderr-to break_string_literals.ml.stderr + (run %{bin:ocamlformat} --name break_string_literals.ml --margin-check --break-string-literals=auto %{dep:../tests/break_string_literals.ml}))))) + +(rule + (alias runtest) + (action (diff break_string_literals.ml.ref break_string_literals.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_string_literals.ml.err break_string_literals.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to break_struct.ml.stdout + (with-stderr-to break_struct.ml.stderr + (run %{bin:ocamlformat} --name break_struct.ml --margin-check %{dep:../tests/break_struct.ml}))))) + +(rule + (alias runtest) + (action (diff break_struct.ml.ref break_struct.ml.stdout))) + +(rule + (alias runtest) + (action (diff break_struct.ml.err break_struct.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to cases_exp_grouping.ml.stdout + (with-stderr-to cases_exp_grouping.ml.stderr + (run %{bin:ocamlformat} --name cases_exp_grouping.ml --margin-check --exp-grouping=preserve %{dep:../tests/cases_exp_grouping.ml}))))) + +(rule + (alias runtest) + (action (diff cases_exp_grouping.ml.ref cases_exp_grouping.ml.stdout))) + +(rule + (alias runtest) + (action (diff cases_exp_grouping.ml.err cases_exp_grouping.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to cinaps.ml.stdout + (with-stderr-to cinaps.ml.stderr + (run %{bin:ocamlformat} --name cinaps.ml --margin-check %{dep:../tests/cinaps.ml}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff cinaps.ml.ref cinaps.ml.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff cinaps.ml.err cinaps.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to class_expr.ml.stdout + (with-stderr-to class_expr.ml.stderr + (run %{bin:ocamlformat} --name class_expr.ml --margin-check %{dep:../tests/class_expr.ml}))))) + +(rule + (alias runtest) + (action (diff class_expr.ml.ref class_expr.ml.stdout))) + +(rule + (alias runtest) + (action (diff class_expr.ml.err class_expr.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to class_sig-after.mli.stdout + (with-stderr-to class_sig-after.mli.stderr + (run %{bin:ocamlformat} --name class_sig-after.mli --margin-check --break-separators=after %{dep:../tests/class_sig.mli}))))) + +(rule + (alias runtest) + (action (diff class_sig-after.mli.ref class_sig-after.mli.stdout))) + +(rule + (alias runtest) + (action (diff class_sig-after.mli.err class_sig-after.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to class_sig.mli.stdout + (with-stderr-to class_sig.mli.stderr + (run %{bin:ocamlformat} --name class_sig.mli --margin-check %{dep:../tests/class_sig.mli}))))) + +(rule + (alias runtest) + (action (diff class_sig.mli.ref class_sig.mli.stdout))) + +(rule + (alias runtest) + (action (diff class_sig.mli.err class_sig.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to class_type.ml.stdout + (with-stderr-to class_type.ml.stderr + (run %{bin:ocamlformat} --name class_type.ml --margin-check --max-iters=3 %{dep:../tests/class_type.ml}))))) + +(rule + (alias runtest) + (action (diff class_type.ml.ref class_type.ml.stdout))) + +(rule + (alias runtest) + (action (diff class_type.ml.err class_type.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to cmdline_override.ml.stdout + (with-stderr-to cmdline_override.ml.stderr + (run %{bin:ocamlformat} --name cmdline_override.ml --margin-check --config=module-item-spacing=compact --module-item-spacing=sparse %{dep:../tests/cmdline_override.ml}))))) + +(rule + (alias runtest) + (action (diff cmdline_override.ml.ref cmdline_override.ml.stdout))) + +(rule + (alias runtest) + (action (diff cmdline_override.ml.err cmdline_override.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to cmdline_override2.ml.stdout + (with-stderr-to cmdline_override2.ml.stderr + (run %{bin:ocamlformat} --name cmdline_override2.ml --margin-check --module-item-spacing=sparse --config=module-item-spacing=compact %{dep:../tests/cmdline_override2.ml}))))) + +(rule + (alias runtest) + (action (diff cmdline_override2.ml.ref cmdline_override2.ml.stdout))) + +(rule + (alias runtest) + (action (diff cmdline_override2.ml.err cmdline_override2.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to coerce.ml.stdout + (with-stderr-to coerce.ml.stderr + (run %{bin:ocamlformat} --name coerce.ml --margin-check %{dep:../tests/coerce.ml}))))) + +(rule + (alias runtest) + (action (diff coerce.ml.ref coerce.ml.stdout))) + +(rule + (alias runtest) + (action (diff coerce.ml.err coerce.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to comment_breaking.ml.stdout + (with-stderr-to comment_breaking.ml.stderr + (run %{bin:ocamlformat} --name comment_breaking.ml --margin-check %{dep:../tests/comment_breaking.ml}))))) + +(rule + (alias runtest) + (action (diff comment_breaking.ml.ref comment_breaking.ml.stdout))) + +(rule + (alias runtest) + (action (diff comment_breaking.ml.err comment_breaking.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to comment_header.ml.stdout + (with-stderr-to comment_header.ml.stderr + (run %{bin:ocamlformat} --name comment_header.ml --margin-check %{dep:../tests/comment_header.ml}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff comment_header.ml.ref comment_header.ml.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff comment_header.ml.err comment_header.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to comment_in_empty.ml.stdout + (with-stderr-to comment_in_empty.ml.stderr + (run %{bin:ocamlformat} --name comment_in_empty.ml --margin-check %{dep:../tests/comment_in_empty.ml}))))) + +(rule + (alias runtest) + (action (diff comment_in_empty.ml.ref comment_in_empty.ml.stdout))) + +(rule + (alias runtest) + (action (diff comment_in_empty.ml.err comment_in_empty.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to comment_in_modules.ml.stdout + (with-stderr-to comment_in_modules.ml.stderr + (run %{bin:ocamlformat} --name comment_in_modules.ml --margin-check %{dep:../tests/comment_in_modules.ml}))))) + +(rule + (alias runtest) + (action (diff comment_in_modules.ml.ref comment_in_modules.ml.stdout))) + +(rule + (alias runtest) + (action (diff comment_in_modules.ml.err comment_in_modules.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to comment_last.ml.stdout + (with-stderr-to comment_last.ml.stderr + (run %{bin:ocamlformat} --name comment_last.ml --margin-check %{dep:../tests/comment_last.ml}))))) + +(rule + (alias runtest) + (action (diff comment_last.ml.ref comment_last.ml.stdout))) + +(rule + (alias runtest) + (action (diff comment_last.ml.err comment_last.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to comment_sparse.ml.stdout + (with-stderr-to comment_sparse.ml.stderr + (run %{bin:ocamlformat} --name comment_sparse.ml --margin-check %{dep:../tests/comment_sparse.ml}))))) + +(rule + (alias runtest) + (action (diff comment_sparse.ml.ref comment_sparse.ml.stdout))) + +(rule + (alias runtest) + (action (diff comment_sparse.ml.err comment_sparse.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to comments-no-wrap.ml.stdout + (with-stderr-to comments-no-wrap.ml.stderr + (run %{bin:ocamlformat} --name comments-no-wrap.ml --margin-check --no-wrap-comments --max-iter=4 %{dep:../tests/comments.ml}))))) + +(rule + (alias runtest) + (action (diff comments-no-wrap.ml.ref comments-no-wrap.ml.stdout))) + +(rule + (alias runtest) + (action (diff comments-no-wrap.ml.err comments-no-wrap.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to comments.ml.stdout + (with-stderr-to comments.ml.stderr + (run %{bin:ocamlformat} --name comments.ml --margin-check --max-iter=4 %{dep:../tests/comments.ml}))))) + +(rule + (alias runtest) + (action (diff comments.ml.ref comments.ml.stdout))) + +(rule + (alias runtest) + (action (diff comments.ml.err comments.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to comments.mli.stdout + (with-stderr-to comments.mli.stderr + (run %{bin:ocamlformat} --name comments.mli --margin-check %{dep:../tests/comments.mli}))))) + +(rule + (alias runtest) + (action (diff comments.mli.ref comments.mli.stdout))) + +(rule + (alias runtest) + (action (diff comments.mli.err comments.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to comments_args.ml.stdout + (with-stderr-to comments_args.ml.stderr + (run %{bin:ocamlformat} --name comments_args.ml --margin-check --max-iter=4 %{dep:../tests/comments_args.ml}))))) + +(rule + (alias runtest) + (action (diff comments_args.ml.ref comments_args.ml.stdout))) + +(rule + (alias runtest) + (action (diff comments_args.ml.err comments_args.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to comments_around_disabled.ml.stdout + (with-stderr-to comments_around_disabled.ml.stderr + (run %{bin:ocamlformat} --name comments_around_disabled.ml --margin-check %{dep:../tests/comments_around_disabled.ml}))))) + +(rule + (alias runtest) + (action (diff comments_around_disabled.ml.ref comments_around_disabled.ml.stdout))) + +(rule + (alias runtest) + (action (diff comments_around_disabled.ml.err comments_around_disabled.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to comments_in_local_let.ml.stdout + (with-stderr-to comments_in_local_let.ml.stderr + (run %{bin:ocamlformat} --name comments_in_local_let.ml --margin-check %{dep:../tests/comments_in_local_let.ml}))))) + +(rule + (alias runtest) + (action (diff comments_in_local_let.ml.ref comments_in_local_let.ml.stdout))) + +(rule + (alias runtest) + (action (diff comments_in_local_let.ml.err comments_in_local_let.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to comments_in_record-break_separator-after.ml.stdout + (with-stderr-to comments_in_record-break_separator-after.ml.stderr + (run %{bin:ocamlformat} --name comments_in_record-break_separator-after.ml --margin-check --break-separator=after %{dep:../tests/comments_in_record.ml}))))) + +(rule + (alias runtest) + (action (diff comments_in_record-break_separator-after.ml.ref comments_in_record-break_separator-after.ml.stdout))) + +(rule + (alias runtest) + (action (diff comments_in_record-break_separator-after.ml.err comments_in_record-break_separator-after.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to comments_in_record-break_separator-before.ml.stdout + (with-stderr-to comments_in_record-break_separator-before.ml.stderr + (run %{bin:ocamlformat} --name comments_in_record-break_separator-before.ml --margin-check --break-separator=before %{dep:../tests/comments_in_record.ml}))))) + +(rule + (alias runtest) + (action (diff comments_in_record-break_separator-before.ml.ref comments_in_record-break_separator-before.ml.stdout))) + +(rule + (alias runtest) + (action (diff comments_in_record-break_separator-before.ml.err comments_in_record-break_separator-before.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to comments_in_record.ml.stdout + (with-stderr-to comments_in_record.ml.stderr + (run %{bin:ocamlformat} --name comments_in_record.ml --margin-check %{dep:../tests/comments_in_record.ml}))))) + +(rule + (alias runtest) + (action (diff comments_in_record.ml.ref comments_in_record.ml.stdout))) + +(rule + (alias runtest) + (action (diff comments_in_record.ml.err comments_in_record.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to crlf_to_crlf.ml.stdout + (with-stderr-to crlf_to_crlf.ml.stderr + (run %{bin:ocamlformat} --name crlf_to_crlf.ml --margin-check --line-endings=crlf %{dep:../tests/crlf_to_crlf.ml}))))) + +(rule + (alias runtest) + (action (diff crlf_to_crlf.ml.ref crlf_to_crlf.ml.stdout))) + +(rule + (alias runtest) + (action (diff crlf_to_crlf.ml.err crlf_to_crlf.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to crlf_to_lf.ml.stdout + (with-stderr-to crlf_to_lf.ml.stderr + (run %{bin:ocamlformat} --name crlf_to_lf.ml --margin-check --line-endings=lf %{dep:../tests/crlf_to_lf.ml}))))) + +(rule + (alias runtest) + (action (diff crlf_to_lf.ml.ref crlf_to_lf.ml.stdout))) + +(rule + (alias runtest) + (action (diff crlf_to_lf.ml.err crlf_to_lf.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to custom_list.ml.stdout + (with-stderr-to custom_list.ml.stderr + (run %{bin:ocamlformat} --name custom_list.ml --margin-check %{dep:../tests/custom_list.ml}))))) + +(rule + (alias runtest) + (action (diff custom_list.ml.ref custom_list.ml.stdout))) + +(rule + (alias runtest) + (action (diff custom_list.ml.err custom_list.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to directives.mlt.stdout + (with-stderr-to directives.mlt.stderr + (run %{bin:ocamlformat} --name directives.mlt --margin-check %{dep:../tests/directives.mlt}))))) + +(rule + (alias runtest) + (action (diff directives.mlt.ref directives.mlt.stdout))) + +(rule + (alias runtest) + (action (diff directives.mlt.err directives.mlt.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to disable_attr.ml.stdout + (with-stderr-to disable_attr.ml.stderr + (run %{bin:ocamlformat} --name disable_attr.ml --margin-check %{dep:../tests/disable_attr.ml}))))) + +(rule + (alias runtest) + (action (diff disable_attr.ml.ref disable_attr.ml.stdout))) + +(rule + (alias runtest) + (action (diff disable_attr.ml.err disable_attr.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to disable_class_type.ml.stdout + (with-stderr-to disable_class_type.ml.stderr + (run %{bin:ocamlformat} --name disable_class_type.ml --margin-check %{dep:../tests/disable_class_type.ml}))))) + +(rule + (alias runtest) + (action (diff disable_class_type.ml.ref disable_class_type.ml.stdout))) + +(rule + (alias runtest) + (action (diff disable_class_type.ml.err disable_class_type.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to disable_conf_attrs.ml.stdout + (with-stderr-to disable_conf_attrs.ml.stderr + (run %{bin:ocamlformat} --name disable_conf_attrs.ml --margin-check --disable-conf-attrs %{dep:../tests/disable_conf_attrs.ml}))))) + +(rule + (alias runtest) + (action (diff disable_conf_attrs.ml.ref disable_conf_attrs.ml.stdout))) + +(rule + (alias runtest) + (action (diff disable_conf_attrs.ml.err disable_conf_attrs.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to disable_local_let.ml.stdout + (with-stderr-to disable_local_let.ml.stderr + (run %{bin:ocamlformat} --name disable_local_let.ml --margin-check %{dep:../tests/disable_local_let.ml}))))) + +(rule + (alias runtest) + (action (diff disable_local_let.ml.ref disable_local_let.ml.stdout))) + +(rule + (alias runtest) + (action (diff disable_local_let.ml.err disable_local_let.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to disabled.ml.stdout + (with-stderr-to disabled.ml.stderr + (run %{bin:ocamlformat} --name disabled.ml --margin-check --disable %{dep:../tests/disabled.ml}))))) + +(rule + (alias runtest) + (action (diff disabled.ml.ref disabled.ml.stdout))) + +(rule + (alias runtest) + (action (diff disabled.ml.err disabled.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to disabled_attr.ml.stdout + (with-stderr-to disabled_attr.ml.stderr + (run %{bin:ocamlformat} --name disabled_attr.ml --margin-check %{dep:../tests/disabled_attr.ml}))))) + +(rule + (alias runtest) + (action (diff disabled_attr.ml.ref disabled_attr.ml.stdout))) + +(rule + (alias runtest) + (action (diff disabled_attr.ml.err disabled_attr.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to disambiguate.ml.stdout + (with-stderr-to disambiguate.ml.stderr + (run %{bin:ocamlformat} --name disambiguate.ml --margin-check %{dep:../tests/disambiguate.ml}))))) + +(rule + (alias runtest) + (action (diff disambiguate.ml.ref disambiguate.ml.stdout))) + +(rule + (alias runtest) + (action (diff disambiguate.ml.err disambiguate.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to disambiguated_types.ml.stdout + (with-stderr-to disambiguated_types.ml.stderr + (run %{bin:ocamlformat} --name disambiguated_types.ml --margin-check %{dep:../tests/disambiguated_types.ml}))))) + +(rule + (alias runtest) + (action (diff disambiguated_types.ml.ref disambiguated_types.ml.stdout))) + +(rule + (alias runtest) + (action (diff disambiguated_types.ml.err disambiguated_types.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to doc.mld.stdout + (with-stderr-to doc.mld.stderr + (run %{bin:ocamlformat} --name doc.mld --margin-check %{dep:../tests/doc.mld}))))) + +(rule + (alias runtest) + (action (diff doc.mld.ref doc.mld.stdout))) + +(rule + (alias runtest) + (action (diff doc.mld.err doc.mld.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to doc_comments-after.ml.stdout + (with-stderr-to doc_comments-after.ml.stderr + (run %{bin:ocamlformat} --name doc_comments-after.ml --margin-check --doc-comments=after-when-possible %{dep:../tests/doc_comments.ml}))))) + +(rule + (alias runtest) + (action (diff doc_comments-after.ml.ref doc_comments-after.ml.stdout))) + +(rule + (alias runtest) + (action (diff doc_comments-after.ml.err doc_comments-after.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to doc_comments-before-except-val.ml.stdout + (with-stderr-to doc_comments-before-except-val.ml.stderr + (run %{bin:ocamlformat} --name doc_comments-before-except-val.ml --margin-check --doc-comments=before-except-val %{dep:../tests/doc_comments.ml}))))) + +(rule + (alias runtest) + (action (diff doc_comments-before-except-val.ml.ref doc_comments-before-except-val.ml.stdout))) + +(rule + (alias runtest) + (action (diff doc_comments-before-except-val.ml.err doc_comments-before-except-val.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to doc_comments-before.ml.stdout + (with-stderr-to doc_comments-before.ml.stderr + (run %{bin:ocamlformat} --name doc_comments-before.ml --margin-check --doc-comments=before %{dep:../tests/doc_comments.ml}))))) + +(rule + (alias runtest) + (action (diff doc_comments-before.ml.ref doc_comments-before.ml.stdout))) + +(rule + (alias runtest) + (action (diff doc_comments-before.ml.err doc_comments-before.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to doc_comments-no-parse-docstrings.mli.stdout + (with-stderr-to doc_comments-no-parse-docstrings.mli.stderr + (run %{bin:ocamlformat} --name doc_comments-no-parse-docstrings.mli --margin-check --no-parse-docstrings --max-iters=3 %{dep:../tests/doc_comments.mli}))))) + +(rule + (alias runtest) + (action (diff doc_comments-no-parse-docstrings.mli.ref doc_comments-no-parse-docstrings.mli.stdout))) + +(rule + (alias runtest) + (action (diff doc_comments-no-parse-docstrings.mli.err doc_comments-no-parse-docstrings.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to doc_comments-no-wrap.mli.stdout + (with-stderr-to doc_comments-no-wrap.mli.stderr + (run %{bin:ocamlformat} --name doc_comments-no-wrap.mli --margin-check --no-wrap-comments %{dep:../tests/doc_comments.mli}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff doc_comments-no-wrap.mli.ref doc_comments-no-wrap.mli.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff doc_comments-no-wrap.mli.err doc_comments-no-wrap.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to doc_comments.ml.stdout + (with-stderr-to doc_comments.ml.stderr + (run %{bin:ocamlformat} --name doc_comments.ml --margin-check %{dep:../tests/doc_comments.ml}))))) + +(rule + (alias runtest) + (action (diff doc_comments.ml.ref doc_comments.ml.stdout))) + +(rule + (alias runtest) + (action (diff doc_comments.ml.err doc_comments.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to doc_comments.mli.stdout + (with-stderr-to doc_comments.mli.stderr + (run %{bin:ocamlformat} --name doc_comments.mli --margin-check %{dep:../tests/doc_comments.mli}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff doc_comments.mli.ref doc_comments.mli.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff doc_comments.mli.err doc_comments.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to doc_comments_padding.ml.stdout + (with-stderr-to doc_comments_padding.ml.stderr + (run %{bin:ocamlformat} --name doc_comments_padding.ml --margin-check %{dep:../tests/doc_comments_padding.ml}))))) + +(rule + (alias runtest) + (action (diff doc_comments_padding.ml.ref doc_comments_padding.ml.stdout))) + +(rule + (alias runtest) + (action (diff doc_comments_padding.ml.err doc_comments_padding.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to doc_repl.mld.stdout + (with-stderr-to doc_repl.mld.stderr + (run %{bin:ocamlformat} --name doc_repl.mld --margin-check --parse-toplevel-phrases %{dep:../tests/doc_repl.mld}))))) + +(rule + (alias runtest) + (action (diff doc_repl.mld.ref doc_repl.mld.stdout))) + +(rule + (alias runtest) + (action (diff doc_repl.mld.err doc_repl.mld.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to docstrings_toplevel_directives.mlt.stdout + (with-stderr-to docstrings_toplevel_directives.mlt.stderr + (run %{bin:ocamlformat} --name docstrings_toplevel_directives.mlt --margin-check %{dep:../tests/docstrings_toplevel_directives.mlt}))))) + +(rule + (alias runtest) + (action (diff docstrings_toplevel_directives.mlt.ref docstrings_toplevel_directives.mlt.stdout))) + +(rule + (alias runtest) + (action (diff docstrings_toplevel_directives.mlt.err docstrings_toplevel_directives.mlt.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to eliom_ext.eliom.stdout + (with-stderr-to eliom_ext.eliom.stderr + (run %{bin:ocamlformat} --name eliom_ext.eliom --margin-check %{dep:../tests/eliom_ext.eliom}))))) + +(rule + (alias runtest) + (action (diff eliom_ext.eliom.ref eliom_ext.eliom.stdout))) + +(rule + (alias runtest) + (action (diff eliom_ext.eliom.err eliom_ext.eliom.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to empty.ml.stdout + (with-stderr-to empty.ml.stderr + (run %{bin:ocamlformat} --name empty.ml --margin-check %{dep:../tests/empty.ml}))))) + +(rule + (alias runtest) + (action (diff empty.ml.ref empty.ml.stdout))) + +(rule + (alias runtest) + (action (diff empty.ml.err empty.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to empty_ml.ml.stdout + (with-stderr-to empty_ml.ml.stderr + (run %{bin:ocamlformat} --name empty_ml.ml --margin-check %{dep:../tests/empty_ml.ml}))))) + +(rule + (alias runtest) + (action (diff empty_ml.ml.ref empty_ml.ml.stdout))) + +(rule + (alias runtest) + (action (diff empty_ml.ml.err empty_ml.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to empty_mli.mli.stdout + (with-stderr-to empty_mli.mli.stderr + (run %{bin:ocamlformat} --name empty_mli.mli --margin-check %{dep:../tests/empty_mli.mli}))))) + +(rule + (alias runtest) + (action (diff empty_mli.mli.ref empty_mli.mli.stdout))) + +(rule + (alias runtest) + (action (diff empty_mli.mli.err empty_mli.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to empty_mlt.mlt.stdout + (with-stderr-to empty_mlt.mlt.stderr + (run %{bin:ocamlformat} --name empty_mlt.mlt --margin-check %{dep:../tests/empty_mlt.mlt}))))) + +(rule + (alias runtest) + (action (diff empty_mlt.mlt.ref empty_mlt.mlt.stdout))) + +(rule + (alias runtest) + (action (diff empty_mlt.mlt.err empty_mlt.mlt.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to error1.ml.stdout + (with-stderr-to error1.ml.stderr + (with-accepted-exit-codes 1 + (run %{bin:ocamlformat} --name error1.ml --margin-check %{dep:../tests/error1.ml})))))) + +(rule + (alias runtest) + (action (diff error1.ml.ref error1.ml.stdout))) + +(rule + (alias runtest) + (action (diff error1.ml.err error1.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to error2.ml.stdout + (with-stderr-to error2.ml.stderr + (with-accepted-exit-codes 1 + (run %{bin:ocamlformat} --name error2.ml --margin-check %{dep:../tests/error2.ml})))))) + +(rule + (alias runtest) + (action (diff error2.ml.ref error2.ml.stdout))) + +(rule + (alias runtest) + (action (diff error2.ml.err error2.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to error3.ml.stdout + (with-stderr-to error3.ml.stderr + (with-accepted-exit-codes 1 + (run %{bin:ocamlformat} --name error3.ml --margin-check %{dep:../tests/error3.ml})))))) + +(rule + (alias runtest) + (action (diff error3.ml.ref error3.ml.stdout))) + +(rule + (alias runtest) + (action (diff error3.ml.err error3.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to error4.ml.stdout + (with-stderr-to error4.ml.stderr + (run %{bin:ocamlformat} --name error4.ml --margin-check --no-comment-check %{dep:../tests/error4.ml}))))) + +(rule + (alias runtest) + (action (diff error4.ml.ref error4.ml.stdout))) + +(rule + (alias runtest) + (action (diff error4.ml.err error4.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to escaped_nl.ml.stdout + (with-stderr-to escaped_nl.ml.stderr + (run %{bin:ocamlformat} --name escaped_nl.ml --margin-check %{dep:../tests/escaped_nl.ml}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff escaped_nl.ml.ref escaped_nl.ml.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff escaped_nl.ml.err escaped_nl.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to exceptions.ml.stdout + (with-stderr-to exceptions.ml.stderr + (run %{bin:ocamlformat} --name exceptions.ml --margin-check %{dep:../tests/exceptions.ml}))))) + +(rule + (alias runtest) + (action (diff exceptions.ml.ref exceptions.ml.stdout))) + +(rule + (alias runtest) + (action (diff exceptions.ml.err exceptions.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to exceptions.mli.stdout + (with-stderr-to exceptions.mli.stderr + (run %{bin:ocamlformat} --name exceptions.mli --margin-check %{dep:../tests/exceptions.mli}))))) + +(rule + (alias runtest) + (action (diff exceptions.mli.ref exceptions.mli.stdout))) + +(rule + (alias runtest) + (action (diff exceptions.mli.err exceptions.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to exp_grouping-parens.ml.stdout + (with-stderr-to exp_grouping-parens.ml.stderr + (run %{bin:ocamlformat} --name exp_grouping-parens.ml --margin-check --exp-grouping=parens %{dep:../tests/exp_grouping.ml}))))) + +(rule + (alias runtest) + (action (diff exp_grouping-parens.ml.ref exp_grouping-parens.ml.stdout))) + +(rule + (alias runtest) + (action (diff exp_grouping-parens.ml.err exp_grouping-parens.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to exp_grouping.ml.stdout + (with-stderr-to exp_grouping.ml.stderr + (run %{bin:ocamlformat} --name exp_grouping.ml --margin-check --exp-grouping=preserve %{dep:../tests/exp_grouping.ml}))))) + +(rule + (alias runtest) + (action (diff exp_grouping.ml.ref exp_grouping.ml.stdout))) + +(rule + (alias runtest) + (action (diff exp_grouping.ml.err exp_grouping.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to exp_record.ml.stdout + (with-stderr-to exp_record.ml.stderr + (run %{bin:ocamlformat} --name exp_record.ml --margin-check %{dep:../tests/exp_record.ml}))))) + +(rule + (alias runtest) + (action (diff exp_record.ml.ref exp_record.ml.stdout))) + +(rule + (alias runtest) + (action (diff exp_record.ml.err exp_record.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to expect_test.ml.stdout + (with-stderr-to expect_test.ml.stderr + (run %{bin:ocamlformat} --name expect_test.ml --margin-check %{dep:../tests/expect_test.ml}))))) + +(rule + (alias runtest) + (action (diff expect_test.ml.ref expect_test.ml.stdout))) + +(rule + (alias runtest) + (action (diff expect_test.ml.err expect_test.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to extensions-indent.ml.stdout + (with-stderr-to extensions-indent.ml.stderr + (run %{bin:ocamlformat} --name extensions-indent.ml --margin-check --max-iters=3 --extension-indent=5 --stritem-extension-indent=3 %{dep:../tests/extensions.ml}))))) + +(rule + (alias runtest) + (action (diff extensions-indent.ml.ref extensions-indent.ml.stdout))) + +(rule + (alias runtest) + (action (diff extensions-indent.ml.err extensions-indent.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to extensions-indent.mli.stdout + (with-stderr-to extensions-indent.mli.stderr + (run %{bin:ocamlformat} --name extensions-indent.mli --margin-check --extension-indent=5 --stritem-extension-indent=3 %{dep:../tests/extensions.mli}))))) + +(rule + (alias runtest) + (action (diff extensions-indent.mli.ref extensions-indent.mli.stdout))) + +(rule + (alias runtest) + (action (diff extensions-indent.mli.err extensions-indent.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to extensions.ml.stdout + (with-stderr-to extensions.ml.stderr + (run %{bin:ocamlformat} --name extensions.ml --margin-check --max-iters=3 %{dep:../tests/extensions.ml}))))) + +(rule + (alias runtest) + (action (diff extensions.ml.ref extensions.ml.stdout))) + +(rule + (alias runtest) + (action (diff extensions.ml.err extensions.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to extensions.mli.stdout + (with-stderr-to extensions.mli.stderr + (run %{bin:ocamlformat} --name extensions.mli --margin-check %{dep:../tests/extensions.mli}))))) + +(rule + (alias runtest) + (action (diff extensions.mli.ref extensions.mli.stdout))) + +(rule + (alias runtest) + (action (diff extensions.mli.err extensions.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to extensions_exp_grouping.ml.stdout + (with-stderr-to extensions_exp_grouping.ml.stderr + (run %{bin:ocamlformat} --name extensions_exp_grouping.ml --margin-check --exp-grouping=preserve %{dep:../tests/extensions_exp_grouping.ml}))))) + +(rule + (alias runtest) + (action (diff extensions_exp_grouping.ml.ref extensions_exp_grouping.ml.stdout))) + +(rule + (alias runtest) + (action (diff extensions_exp_grouping.ml.err extensions_exp_grouping.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to field-op_begin_line.ml.stdout + (with-stderr-to field-op_begin_line.ml.stderr + (run %{bin:ocamlformat} --name field-op_begin_line.ml --margin-check --assignment-operator=begin-line %{dep:../tests/field.ml}))))) + +(rule + (alias runtest) + (action (diff field-op_begin_line.ml.ref field-op_begin_line.ml.stdout))) + +(rule + (alias runtest) + (action (diff field-op_begin_line.ml.err field-op_begin_line.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to field.ml.stdout + (with-stderr-to field.ml.stderr + (run %{bin:ocamlformat} --name field.ml --margin-check %{dep:../tests/field.ml}))))) + +(rule + (alias runtest) + (action (diff field.ml.ref field.ml.stdout))) + +(rule + (alias runtest) + (action (diff field.ml.err field.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to first_class_module.ml.stdout + (with-stderr-to first_class_module.ml.stderr + (run %{bin:ocamlformat} --name first_class_module.ml --margin-check %{dep:../tests/first_class_module.ml}))))) + +(rule + (alias runtest) + (action (diff first_class_module.ml.ref first_class_module.ml.stdout))) + +(rule + (alias runtest) + (action (diff first_class_module.ml.err first_class_module.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to floating_doc.ml.stdout + (with-stderr-to floating_doc.ml.stderr + (run %{bin:ocamlformat} --name floating_doc.ml --margin-check %{dep:../tests/floating_doc.ml}))))) + +(rule + (alias runtest) + (action (diff floating_doc.ml.ref floating_doc.ml.stdout))) + +(rule + (alias runtest) + (action (diff floating_doc.ml.err floating_doc.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to for_while.ml.stdout + (with-stderr-to for_while.ml.stderr + (run %{bin:ocamlformat} --name for_while.ml --margin-check %{dep:../tests/for_while.ml}))))) + +(rule + (alias runtest) + (action (diff for_while.ml.ref for_while.ml.stdout))) + +(rule + (alias runtest) + (action (diff for_while.ml.err for_while.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to fun_decl-no-wrap-fun-args.ml.stdout + (with-stderr-to fun_decl-no-wrap-fun-args.ml.stderr + (run %{bin:ocamlformat} --name fun_decl-no-wrap-fun-args.ml --margin-check --no-wrap-fun-args %{dep:../tests/fun_decl.ml}))))) + +(rule + (alias runtest) + (action (diff fun_decl-no-wrap-fun-args.ml.ref fun_decl-no-wrap-fun-args.ml.stdout))) + +(rule + (alias runtest) + (action (diff fun_decl-no-wrap-fun-args.ml.err fun_decl-no-wrap-fun-args.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to fun_decl.ml.stdout + (with-stderr-to fun_decl.ml.stderr + (run %{bin:ocamlformat} --name fun_decl.ml --margin-check %{dep:../tests/fun_decl.ml}))))) + +(rule + (alias runtest) + (action (diff fun_decl.ml.ref fun_decl.ml.stdout))) + +(rule + (alias runtest) + (action (diff fun_decl.ml.err fun_decl.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to fun_function.ml.stdout + (with-stderr-to fun_function.ml.stderr + (run %{bin:ocamlformat} --name fun_function.ml --margin-check --max-iter=3 %{dep:../tests/fun_function.ml}))))) + +(rule + (alias runtest) + (action (diff fun_function.ml.ref fun_function.ml.stdout))) + +(rule + (alias runtest) + (action (diff fun_function.ml.err fun_function.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to function_indent-never.ml.stdout + (with-stderr-to function_indent-never.ml.stderr + (run %{bin:ocamlformat} --name function_indent-never.ml --margin-check --function-indent=4 --function-indent-nested=never %{dep:../tests/function_indent.ml}))))) + +(rule + (alias runtest) + (action (diff function_indent-never.ml.ref function_indent-never.ml.stdout))) + +(rule + (alias runtest) + (action (diff function_indent-never.ml.err function_indent-never.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to function_indent.ml.stdout + (with-stderr-to function_indent.ml.stderr + (run %{bin:ocamlformat} --name function_indent.ml --margin-check --function-indent=4 --function-indent-nested=always %{dep:../tests/function_indent.ml}))))) + +(rule + (alias runtest) + (action (diff function_indent.ml.ref function_indent.ml.stdout))) + +(rule + (alias runtest) + (action (diff function_indent.ml.err function_indent.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to functor.ml.stdout + (with-stderr-to functor.ml.stderr + (run %{bin:ocamlformat} --name functor.ml --margin-check %{dep:../tests/functor.ml}))))) + +(rule + (alias runtest) + (action (diff functor.ml.ref functor.ml.stdout))) + +(rule + (alias runtest) + (action (diff functor.ml.err functor.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to functor.mli.stdout + (with-stderr-to functor.mli.stderr + (run %{bin:ocamlformat} --name functor.mli --margin-check %{dep:../tests/functor.mli}))))) + +(rule + (alias runtest) + (action (diff functor.mli.ref functor.mli.stdout))) + +(rule + (alias runtest) + (action (diff functor.mli.err functor.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to funsig.ml.stdout + (with-stderr-to funsig.ml.stderr + (run %{bin:ocamlformat} --name funsig.ml --margin-check %{dep:../tests/funsig.ml}))))) + +(rule + (alias runtest) + (action (diff funsig.ml.ref funsig.ml.stdout))) + +(rule + (alias runtest) + (action (diff funsig.ml.err funsig.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to gadt.ml.stdout + (with-stderr-to gadt.ml.stderr + (run %{bin:ocamlformat} --name gadt.ml --margin-check %{dep:../tests/gadt.ml}))))) + +(rule + (alias runtest) + (action (diff gadt.ml.ref gadt.ml.stdout))) + +(rule + (alias runtest) + (action (diff gadt.ml.err gadt.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to generative.ml.stdout + (with-stderr-to generative.ml.stderr + (run %{bin:ocamlformat} --name generative.ml --margin-check --max-iters=3 %{dep:../tests/generative.ml}))))) + +(rule + (alias runtest) + (action (diff generative.ml.ref generative.ml.stdout))) + +(rule + (alias runtest) + (action (diff generative.ml.err generative.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to hash_bang.ml.stdout + (with-stderr-to hash_bang.ml.stderr + (run %{bin:ocamlformat} --name hash_bang.ml --margin-check %{dep:../tests/hash_bang.ml}))))) + +(rule + (alias runtest) + (action (diff hash_bang.ml.ref hash_bang.ml.stdout))) + +(rule + (alias runtest) + (action (diff hash_bang.ml.err hash_bang.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to hash_types.ml.stdout + (with-stderr-to hash_types.ml.stderr + (run %{bin:ocamlformat} --name hash_types.ml --margin-check %{dep:../tests/hash_types.ml}))))) + +(rule + (alias runtest) + (action (diff hash_types.ml.ref hash_types.ml.stdout))) + +(rule + (alias runtest) + (action (diff hash_types.ml.err hash_types.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to holes.ml.stdout + (with-stderr-to holes.ml.stderr + (run %{bin:ocamlformat} --name holes.ml --margin-check %{dep:../tests/holes.ml}))))) + +(rule + (alias runtest) + (action (diff holes.ml.ref holes.ml.stdout))) + +(rule + (alias runtest) + (action (diff holes.ml.err holes.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ifand.ml.stdout + (with-stderr-to ifand.ml.stderr + (run %{bin:ocamlformat} --name ifand.ml --margin-check %{dep:../tests/ifand.ml}))))) + +(rule + (alias runtest) + (action (diff ifand.ml.ref ifand.ml.stdout))) + +(rule + (alias runtest) + (action (diff ifand.ml.err ifand.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to index_op.ml.stdout + (with-stderr-to index_op.ml.stderr + (run %{bin:ocamlformat} --name index_op.ml --margin-check %{dep:../tests/index_op.ml}))))) + +(rule + (alias runtest) + (action (diff index_op.ml.ref index_op.ml.stdout))) + +(rule + (alias runtest) + (action (diff index_op.ml.err index_op.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to indicate_multiline_delimiters-cosl.ml.stdout + (with-stderr-to indicate_multiline_delimiters-cosl.ml.stderr + (run %{bin:ocamlformat} --name indicate_multiline_delimiters-cosl.ml --margin-check --indicate-multiline-delimiters=closing-on-separate-line %{dep:../tests/indicate_multiline_delimiters.ml}))))) + +(rule + (alias runtest) + (action (diff indicate_multiline_delimiters-cosl.ml.ref indicate_multiline_delimiters-cosl.ml.stdout))) + +(rule + (alias runtest) + (action (diff indicate_multiline_delimiters-cosl.ml.err indicate_multiline_delimiters-cosl.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to indicate_multiline_delimiters-space.ml.stdout + (with-stderr-to indicate_multiline_delimiters-space.ml.stderr + (run %{bin:ocamlformat} --name indicate_multiline_delimiters-space.ml --margin-check --indicate-multiline-delimiters=space %{dep:../tests/indicate_multiline_delimiters.ml}))))) + +(rule + (alias runtest) + (action (diff indicate_multiline_delimiters-space.ml.ref indicate_multiline_delimiters-space.ml.stdout))) + +(rule + (alias runtest) + (action (diff indicate_multiline_delimiters-space.ml.err indicate_multiline_delimiters-space.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to indicate_multiline_delimiters.ml.stdout + (with-stderr-to indicate_multiline_delimiters.ml.stderr + (run %{bin:ocamlformat} --name indicate_multiline_delimiters.ml --margin-check --indicate-multiline-delimiters=no %{dep:../tests/indicate_multiline_delimiters.ml}))))) + +(rule + (alias runtest) + (action (diff indicate_multiline_delimiters.ml.ref indicate_multiline_delimiters.ml.stdout))) + +(rule + (alias runtest) + (action (diff indicate_multiline_delimiters.ml.err indicate_multiline_delimiters.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to infix_arg_grouping.ml.stdout + (with-stderr-to infix_arg_grouping.ml.stderr + (run %{bin:ocamlformat} --name infix_arg_grouping.ml --margin-check %{dep:../tests/infix_arg_grouping.ml}))))) + +(rule + (alias runtest) + (action (diff infix_arg_grouping.ml.ref infix_arg_grouping.ml.stdout))) + +(rule + (alias runtest) + (action (diff infix_arg_grouping.ml.err infix_arg_grouping.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to infix_bind-break.ml.stdout + (with-stderr-to infix_bind-break.ml.stderr + (run %{bin:ocamlformat} --name infix_bind-break.ml --margin-check --break-infix=wrap --break-infix-before-func --max-iters=3 %{dep:../tests/infix_bind.ml}))))) + +(rule + (alias runtest) + (action (diff infix_bind-break.ml.ref infix_bind-break.ml.stdout))) + +(rule + (alias runtest) + (action (diff infix_bind-break.ml.err infix_bind-break.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to infix_bind-fit_or_vertical-break.ml.stdout + (with-stderr-to infix_bind-fit_or_vertical-break.ml.stderr + (run %{bin:ocamlformat} --name infix_bind-fit_or_vertical-break.ml --margin-check --break-infix=fit-or-vertical --break-infix-before-func --max-iters=3 %{dep:../tests/infix_bind.ml}))))) + +(rule + (alias runtest) + (action (diff infix_bind-fit_or_vertical-break.ml.ref infix_bind-fit_or_vertical-break.ml.stdout))) + +(rule + (alias runtest) + (action (diff infix_bind-fit_or_vertical-break.ml.err infix_bind-fit_or_vertical-break.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to infix_bind-fit_or_vertical.ml.stdout + (with-stderr-to infix_bind-fit_or_vertical.ml.stderr + (run %{bin:ocamlformat} --name infix_bind-fit_or_vertical.ml --margin-check --break-infix=fit-or-vertical --no-break-infix-before-func %{dep:../tests/infix_bind.ml}))))) + +(rule + (alias runtest) + (action (diff infix_bind-fit_or_vertical.ml.ref infix_bind-fit_or_vertical.ml.stdout))) + +(rule + (alias runtest) + (action (diff infix_bind-fit_or_vertical.ml.err infix_bind-fit_or_vertical.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to infix_bind.ml.stdout + (with-stderr-to infix_bind.ml.stderr + (run %{bin:ocamlformat} --name infix_bind.ml --margin-check --break-infix=wrap --no-break-infix-before-func %{dep:../tests/infix_bind.ml}))))) + +(rule + (alias runtest) + (action (diff infix_bind.ml.ref infix_bind.ml.stdout))) + +(rule + (alias runtest) + (action (diff infix_bind.ml.err infix_bind.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to infix_precedence.ml.stdout + (with-stderr-to infix_precedence.ml.stderr + (run %{bin:ocamlformat} --name infix_precedence.ml --margin-check --infix-precedence=parens %{dep:../tests/infix_precedence.ml}))))) + +(rule + (alias runtest) + (action (diff infix_precedence.ml.ref infix_precedence.ml.stdout))) + +(rule + (alias runtest) + (action (diff infix_precedence.ml.err infix_precedence.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to injectivity.ml.stdout + (with-stderr-to injectivity.ml.stderr + (run %{bin:ocamlformat} --name injectivity.ml --margin-check %{dep:../tests/injectivity.ml}))))) + +(rule + (alias runtest) + (action (diff injectivity.ml.ref injectivity.ml.stdout))) + +(rule + (alias runtest) + (action (diff injectivity.ml.err injectivity.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to into_infix.ml.stdout + (with-stderr-to into_infix.ml.stderr + (run %{bin:ocamlformat} --name into_infix.ml --margin-check %{dep:../tests/into_infix.ml}))))) + +(rule + (alias runtest) + (action (diff into_infix.ml.ref into_infix.ml.stdout))) + +(rule + (alias runtest) + (action (diff into_infix.ml.err into_infix.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to invalid.ml.stdout + (with-stderr-to invalid.ml.stderr + (run %{bin:ocamlformat} --name invalid.ml --margin-check %{dep:../tests/invalid.ml}))))) + +(rule + (alias runtest) + (action (diff invalid.ml.ref invalid.ml.stdout))) + +(rule + (alias runtest) + (action (diff invalid.ml.err invalid.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to invalid_docstring.ml.stdout + (with-stderr-to invalid_docstring.ml.stderr + (run %{bin:ocamlformat} --name invalid_docstring.ml --margin-check %{dep:../tests/invalid_docstring.ml}))))) + +(rule + (alias runtest) + (action (diff invalid_docstring.ml.ref invalid_docstring.ml.stdout))) + +(rule + (alias runtest) + (action (diff invalid_docstring.ml.err invalid_docstring.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to invalid_docstrings.mli.stdout + (with-stderr-to invalid_docstrings.mli.stderr + (run %{bin:ocamlformat} --name invalid_docstrings.mli --margin-check %{dep:../tests/invalid_docstrings.mli}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff invalid_docstrings.mli.ref invalid_docstrings.mli.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff invalid_docstrings.mli.err invalid_docstrings.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to issue114.ml.stdout + (with-stderr-to issue114.ml.stderr + (run %{bin:ocamlformat} --name issue114.ml --margin-check %{dep:../tests/issue114.ml}))))) + +(rule + (alias runtest) + (action (diff issue114.ml.ref issue114.ml.stdout))) + +(rule + (alias runtest) + (action (diff issue114.ml.err issue114.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to issue1750.ml.stdout + (with-stderr-to issue1750.ml.stderr + (run %{bin:ocamlformat} --name issue1750.ml --margin-check %{dep:../tests/issue1750.ml}))))) + +(rule + (alias runtest) + (action (diff issue1750.ml.ref issue1750.ml.stdout))) + +(rule + (alias runtest) + (action (diff issue1750.ml.err issue1750.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to issue289.ml.stdout + (with-stderr-to issue289.ml.stderr + (run %{bin:ocamlformat} --name issue289.ml --margin-check %{dep:../tests/issue289.ml}))))) + +(rule + (alias runtest) + (action (diff issue289.ml.ref issue289.ml.stdout))) + +(rule + (alias runtest) + (action (diff issue289.ml.err issue289.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to issue48.ml.stdout + (with-stderr-to issue48.ml.stderr + (run %{bin:ocamlformat} --name issue48.ml --margin-check %{dep:../tests/issue48.ml}))))) + +(rule + (alias runtest) + (action (diff issue48.ml.ref issue48.ml.stdout))) + +(rule + (alias runtest) + (action (diff issue48.ml.err issue48.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to issue51.ml.stdout + (with-stderr-to issue51.ml.stderr + (run %{bin:ocamlformat} --name issue51.ml --margin-check %{dep:../tests/issue51.ml}))))) + +(rule + (alias runtest) + (action (diff issue51.ml.ref issue51.ml.stdout))) + +(rule + (alias runtest) + (action (diff issue51.ml.err issue51.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to issue57.ml.stdout + (with-stderr-to issue57.ml.stderr + (run %{bin:ocamlformat} --name issue57.ml --margin-check %{dep:../tests/issue57.ml}))))) + +(rule + (alias runtest) + (action (diff issue57.ml.ref issue57.ml.stdout))) + +(rule + (alias runtest) + (action (diff issue57.ml.err issue57.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to issue60.ml.stdout + (with-stderr-to issue60.ml.stderr + (run %{bin:ocamlformat} --name issue60.ml --margin-check %{dep:../tests/issue60.ml}))))) + +(rule + (alias runtest) + (action (diff issue60.ml.ref issue60.ml.stdout))) + +(rule + (alias runtest) + (action (diff issue60.ml.err issue60.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to issue77.ml.stdout + (with-stderr-to issue77.ml.stderr + (run %{bin:ocamlformat} --name issue77.ml --margin-check %{dep:../tests/issue77.ml}))))) + +(rule + (alias runtest) + (action (diff issue77.ml.ref issue77.ml.stdout))) + +(rule + (alias runtest) + (action (diff issue77.ml.err issue77.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to issue85.ml.stdout + (with-stderr-to issue85.ml.stderr + (run %{bin:ocamlformat} --name issue85.ml --margin-check %{dep:../tests/issue85.ml}))))) + +(rule + (alias runtest) + (action (diff issue85.ml.ref issue85.ml.stdout))) + +(rule + (alias runtest) + (action (diff issue85.ml.err issue85.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to issue89.ml.stdout + (with-stderr-to issue89.ml.stderr + (run %{bin:ocamlformat} --name issue89.ml --margin-check %{dep:../tests/issue89.ml}))))) + +(rule + (alias runtest) + (action (diff issue89.ml.ref issue89.ml.stdout))) + +(rule + (alias runtest) + (action (diff issue89.ml.err issue89.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ite-compact.ml.stdout + (with-stderr-to ite-compact.ml.stderr + (run %{bin:ocamlformat} --name ite-compact.ml --margin-check --if-then-else=compact %{dep:../tests/ite.ml}))))) + +(rule + (alias runtest) + (action (diff ite-compact.ml.ref ite-compact.ml.stdout))) + +(rule + (alias runtest) + (action (diff ite-compact.ml.err ite-compact.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ite-compact_closing.ml.stdout + (with-stderr-to ite-compact_closing.ml.stderr + (run %{bin:ocamlformat} --name ite-compact_closing.ml --margin-check --if-then-else=compact --indicate-multiline-delimiters=closing-on-separate-line %{dep:../tests/ite.ml}))))) + +(rule + (alias runtest) + (action (diff ite-compact_closing.ml.ref ite-compact_closing.ml.stdout))) + +(rule + (alias runtest) + (action (diff ite-compact_closing.ml.err ite-compact_closing.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ite-fit_or_vertical.ml.stdout + (with-stderr-to ite-fit_or_vertical.ml.stderr + (run %{bin:ocamlformat} --name ite-fit_or_vertical.ml --margin-check --if-then-else=fit-or-vertical %{dep:../tests/ite.ml}))))) + +(rule + (alias runtest) + (action (diff ite-fit_or_vertical.ml.ref ite-fit_or_vertical.ml.stdout))) + +(rule + (alias runtest) + (action (diff ite-fit_or_vertical.ml.err ite-fit_or_vertical.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ite-fit_or_vertical_closing.ml.stdout + (with-stderr-to ite-fit_or_vertical_closing.ml.stderr + (run %{bin:ocamlformat} --name ite-fit_or_vertical_closing.ml --margin-check --if-then-else fit-or-vertical --indicate-multiline-delimiters=closing-on-separate-line %{dep:../tests/ite.ml}))))) + +(rule + (alias runtest) + (action (diff ite-fit_or_vertical_closing.ml.ref ite-fit_or_vertical_closing.ml.stdout))) + +(rule + (alias runtest) + (action (diff ite-fit_or_vertical_closing.ml.err ite-fit_or_vertical_closing.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ite-fit_or_vertical_no_indicate.ml.stdout + (with-stderr-to ite-fit_or_vertical_no_indicate.ml.stderr + (run %{bin:ocamlformat} --name ite-fit_or_vertical_no_indicate.ml --margin-check --if-then-else=fit-or-vertical --indicate-multiline-delimiters=no %{dep:../tests/ite.ml}))))) + +(rule + (alias runtest) + (action (diff ite-fit_or_vertical_no_indicate.ml.ref ite-fit_or_vertical_no_indicate.ml.stdout))) + +(rule + (alias runtest) + (action (diff ite-fit_or_vertical_no_indicate.ml.err ite-fit_or_vertical_no_indicate.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ite-kr.ml.stdout + (with-stderr-to ite-kr.ml.stderr + (run %{bin:ocamlformat} --name ite-kr.ml --margin-check --if-then-else=k-r --max-iters=3 %{dep:../tests/ite.ml}))))) + +(rule + (alias runtest) + (action (diff ite-kr.ml.ref ite-kr.ml.stdout))) + +(rule + (alias runtest) + (action (diff ite-kr.ml.err ite-kr.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ite-kr_closing.ml.stdout + (with-stderr-to ite-kr_closing.ml.stderr + (run %{bin:ocamlformat} --name ite-kr_closing.ml --margin-check --if-then-else=k-r --max-iters=3 --indicate-multiline-delimiters=closing-on-separate-line %{dep:../tests/ite.ml}))))) + +(rule + (alias runtest) + (action (diff ite-kr_closing.ml.ref ite-kr_closing.ml.stdout))) + +(rule + (alias runtest) + (action (diff ite-kr_closing.ml.err ite-kr_closing.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ite-kw_first.ml.stdout + (with-stderr-to ite-kw_first.ml.stderr + (run %{bin:ocamlformat} --name ite-kw_first.ml --margin-check --if-then-else=keyword-first %{dep:../tests/ite.ml}))))) + +(rule + (alias runtest) + (action (diff ite-kw_first.ml.ref ite-kw_first.ml.stdout))) + +(rule + (alias runtest) + (action (diff ite-kw_first.ml.err ite-kw_first.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ite-kw_first_closing.ml.stdout + (with-stderr-to ite-kw_first_closing.ml.stderr + (run %{bin:ocamlformat} --name ite-kw_first_closing.ml --margin-check --if-then-else keyword-first --indicate-multiline-delimiters=closing-on-separate-line %{dep:../tests/ite.ml}))))) + +(rule + (alias runtest) + (action (diff ite-kw_first_closing.ml.ref ite-kw_first_closing.ml.stdout))) + +(rule + (alias runtest) + (action (diff ite-kw_first_closing.ml.err ite-kw_first_closing.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ite-kw_first_no_indicate.ml.stdout + (with-stderr-to ite-kw_first_no_indicate.ml.stderr + (run %{bin:ocamlformat} --name ite-kw_first_no_indicate.ml --margin-check --if-then-else=keyword-first --indicate-multiline-delimiters=no %{dep:../tests/ite.ml}))))) + +(rule + (alias runtest) + (action (diff ite-kw_first_no_indicate.ml.ref ite-kw_first_no_indicate.ml.stdout))) + +(rule + (alias runtest) + (action (diff ite-kw_first_no_indicate.ml.err ite-kw_first_no_indicate.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ite-no_indicate.ml.stdout + (with-stderr-to ite-no_indicate.ml.stderr + (run %{bin:ocamlformat} --name ite-no_indicate.ml --margin-check --if-then-else=compact --indicate-multiline-delimiters=no %{dep:../tests/ite.ml}))))) + +(rule + (alias runtest) + (action (diff ite-no_indicate.ml.ref ite-no_indicate.ml.stdout))) + +(rule + (alias runtest) + (action (diff ite-no_indicate.ml.err ite-no_indicate.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ite-vertical.ml.stdout + (with-stderr-to ite-vertical.ml.stderr + (run %{bin:ocamlformat} --name ite-vertical.ml --margin-check --if-then-else=vertical %{dep:../tests/ite.ml}))))) + +(rule + (alias runtest) + (action (diff ite-vertical.ml.ref ite-vertical.ml.stdout))) + +(rule + (alias runtest) + (action (diff ite-vertical.ml.err ite-vertical.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ite.ml.stdout + (with-stderr-to ite.ml.stderr + (run %{bin:ocamlformat} --name ite.ml --margin-check --if-then-else=compact %{dep:../tests/ite.ml}))))) + +(rule + (alias runtest) + (action (diff ite.ml.ref ite.ml.stdout))) + +(rule + (alias runtest) + (action (diff ite.ml.err ite.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to js_args.ml.stdout + (with-stderr-to js_args.ml.stderr + (run %{bin:ocamlformat} --name js_args.ml --margin-check --max-iter=3 %{dep:../tests/js_args.ml}))))) + +(rule + (alias runtest) + (action (diff js_args.ml.ref js_args.ml.stdout))) + +(rule + (alias runtest) + (action (diff js_args.ml.err js_args.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to js_begin.ml.stdout + (with-stderr-to js_begin.ml.stderr + (run %{bin:ocamlformat} --name js_begin.ml --margin-check %{dep:../tests/js_begin.ml}))))) + +(rule + (alias runtest) + (action (diff js_begin.ml.ref js_begin.ml.stdout))) + +(rule + (alias runtest) + (action (diff js_begin.ml.err js_begin.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to js_bind.ml.stdout + (with-stderr-to js_bind.ml.stderr + (run %{bin:ocamlformat} --name js_bind.ml --margin-check %{dep:../tests/js_bind.ml}))))) + +(rule + (alias runtest) + (action (diff js_bind.ml.ref js_bind.ml.stdout))) + +(rule + (alias runtest) + (action (diff js_bind.ml.err js_bind.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to js_fun.ml.stdout + (with-stderr-to js_fun.ml.stderr + (run %{bin:ocamlformat} --name js_fun.ml --margin-check --max-iter=3 %{dep:../tests/js_fun.ml}))))) + +(rule + (alias runtest) + (action (diff js_fun.ml.ref js_fun.ml.stdout))) + +(rule + (alias runtest) + (action (diff js_fun.ml.err js_fun.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to js_map.ml.stdout + (with-stderr-to js_map.ml.stderr + (run %{bin:ocamlformat} --name js_map.ml --margin-check --max-iter=3 %{dep:../tests/js_map.ml}))))) + +(rule + (alias runtest) + (action (diff js_map.ml.ref js_map.ml.stdout))) + +(rule + (alias runtest) + (action (diff js_map.ml.err js_map.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to js_pattern.ml.stdout + (with-stderr-to js_pattern.ml.stderr + (run %{bin:ocamlformat} --name js_pattern.ml --margin-check %{dep:../tests/js_pattern.ml}))))) + +(rule + (alias runtest) + (action (diff js_pattern.ml.ref js_pattern.ml.stdout))) + +(rule + (alias runtest) + (action (diff js_pattern.ml.err js_pattern.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to js_poly.ml.stdout + (with-stderr-to js_poly.ml.stderr + (run %{bin:ocamlformat} --name js_poly.ml --margin-check --max-iter=3 %{dep:../tests/js_poly.ml}))))) + +(rule + (alias runtest) + (action (diff js_poly.ml.ref js_poly.ml.stdout))) + +(rule + (alias runtest) + (action (diff js_poly.ml.err js_poly.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to js_record.ml.stdout + (with-stderr-to js_record.ml.stderr + (run %{bin:ocamlformat} --name js_record.ml --margin-check --max-iter=3 %{dep:../tests/js_record.ml}))))) + +(rule + (alias runtest) + (action (diff js_record.ml.ref js_record.ml.stdout))) + +(rule + (alias runtest) + (action (diff js_record.ml.err js_record.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to js_sig.mli.stdout + (with-stderr-to js_sig.mli.stderr + (run %{bin:ocamlformat} --name js_sig.mli --margin-check %{dep:../tests/js_sig.mli}))))) + +(rule + (alias runtest) + (action (diff js_sig.mli.ref js_sig.mli.stdout))) + +(rule + (alias runtest) + (action (diff js_sig.mli.err js_sig.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to js_source.ml.stdout + (with-stderr-to js_source.ml.stderr + (run %{bin:ocamlformat} --name js_source.ml --margin-check --max-iters=3 %{dep:../tests/js_source.ml}))))) + +(rule + (alias runtest) + (action (diff js_source.ml.ref js_source.ml.stdout))) + +(rule + (alias runtest) + (action (diff js_source.ml.err js_source.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to js_syntax.ml.stdout + (with-stderr-to js_syntax.ml.stderr + (run %{bin:ocamlformat} --name js_syntax.ml --margin-check %{dep:../tests/js_syntax.ml}))))) + +(rule + (alias runtest) + (action (diff js_syntax.ml.ref js_syntax.ml.stdout))) + +(rule + (alias runtest) + (action (diff js_syntax.ml.err js_syntax.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to js_to_do.ml.stdout + (with-stderr-to js_to_do.ml.stderr + (run %{bin:ocamlformat} --name js_to_do.ml --margin-check %{dep:../tests/js_to_do.ml}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff js_to_do.ml.ref js_to_do.ml.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff js_to_do.ml.err js_to_do.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to js_upon.ml.stdout + (with-stderr-to js_upon.ml.stderr + (run %{bin:ocamlformat} --name js_upon.ml --margin-check %{dep:../tests/js_upon.ml}))))) + +(rule + (alias runtest) + (action (diff js_upon.ml.ref js_upon.ml.stdout))) + +(rule + (alias runtest) + (action (diff js_upon.ml.err js_upon.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to kw_extentions.ml.stdout + (with-stderr-to kw_extentions.ml.stderr + (run %{bin:ocamlformat} --name kw_extentions.ml --margin-check %{dep:../tests/kw_extentions.ml}))))) + +(rule + (alias runtest) + (action (diff kw_extentions.ml.ref kw_extentions.ml.stdout))) + +(rule + (alias runtest) + (action (diff kw_extentions.ml.err kw_extentions.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to label_option_default_args.ml.stdout + (with-stderr-to label_option_default_args.ml.stderr + (run %{bin:ocamlformat} --name label_option_default_args.ml --margin-check --max-iters=4 %{dep:../tests/label_option_default_args.ml}))))) + +(rule + (alias runtest) + (action (diff label_option_default_args.ml.ref label_option_default_args.ml.stdout))) + +(rule + (alias runtest) + (action (diff label_option_default_args.ml.err label_option_default_args.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to labelled_args-414.ml.stdout + (with-stderr-to labelled_args-414.ml.stderr + (run %{bin:ocamlformat} --name labelled_args-414.ml --margin-check --ocaml-version=4.14.0 %{dep:../tests/labelled_args.ml}))))) + +(rule + (alias runtest) + (action (diff labelled_args-414.ml.ref labelled_args-414.ml.stdout))) + +(rule + (alias runtest) + (action (diff labelled_args-414.ml.err labelled_args-414.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to labelled_args.ml.stdout + (with-stderr-to labelled_args.ml.stderr + (run %{bin:ocamlformat} --name labelled_args.ml --margin-check %{dep:../tests/labelled_args.ml}))))) + +(rule + (alias runtest) + (action (diff labelled_args.ml.ref labelled_args.ml.stdout))) + +(rule + (alias runtest) + (action (diff labelled_args.ml.err labelled_args.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to lazy.ml.stdout + (with-stderr-to lazy.ml.stderr + (run %{bin:ocamlformat} --name lazy.ml --margin-check %{dep:../tests/lazy.ml}))))) + +(rule + (alias runtest) + (action (diff lazy.ml.ref lazy.ml.stdout))) + +(rule + (alias runtest) + (action (diff lazy.ml.err lazy.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to let_binding-deindent-fun.ml.stdout + (with-stderr-to let_binding-deindent-fun.ml.stderr + (run %{bin:ocamlformat} --name let_binding-deindent-fun.ml --margin-check --no-let-binding-deindent-fun %{dep:../tests/let_binding.ml}))))) + +(rule + (alias runtest) + (action (diff let_binding-deindent-fun.ml.ref let_binding-deindent-fun.ml.stdout))) + +(rule + (alias runtest) + (action (diff let_binding-deindent-fun.ml.err let_binding-deindent-fun.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to let_binding-in_indent.ml.stdout + (with-stderr-to let_binding-in_indent.ml.stderr + (run %{bin:ocamlformat} --name let_binding-in_indent.ml --margin-check --indent-after-in=4 %{dep:../tests/let_binding.ml}))))) + +(rule + (alias runtest) + (action (diff let_binding-in_indent.ml.ref let_binding-in_indent.ml.stdout))) + +(rule + (alias runtest) + (action (diff let_binding-in_indent.ml.err let_binding-in_indent.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to let_binding-indent.ml.stdout + (with-stderr-to let_binding-indent.ml.stderr + (run %{bin:ocamlformat} --name let_binding-indent.ml --margin-check --let-binding-indent=6 %{dep:../tests/let_binding.ml}))))) + +(rule + (alias runtest) + (action (diff let_binding-indent.ml.ref let_binding-indent.ml.stdout))) + +(rule + (alias runtest) + (action (diff let_binding-indent.ml.err let_binding-indent.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to let_binding.ml.stdout + (with-stderr-to let_binding.ml.stderr + (run %{bin:ocamlformat} --name let_binding.ml --margin-check %{dep:../tests/let_binding.ml}))))) + +(rule + (alias runtest) + (action (diff let_binding.ml.ref let_binding.ml.stdout))) + +(rule + (alias runtest) + (action (diff let_binding.ml.err let_binding.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to let_binding_spacing-double-semicolon.ml.stdout + (with-stderr-to let_binding_spacing-double-semicolon.ml.stderr + (run %{bin:ocamlformat} --name let_binding_spacing-double-semicolon.ml --margin-check --let-binding-spacing=double-semicolon %{dep:../tests/let_binding_spacing.ml}))))) + +(rule + (alias runtest) + (action (diff let_binding_spacing-double-semicolon.ml.ref let_binding_spacing-double-semicolon.ml.stdout))) + +(rule + (alias runtest) + (action (diff let_binding_spacing-double-semicolon.ml.err let_binding_spacing-double-semicolon.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to let_binding_spacing-sparse.ml.stdout + (with-stderr-to let_binding_spacing-sparse.ml.stderr + (run %{bin:ocamlformat} --name let_binding_spacing-sparse.ml --margin-check --let-binding-spacing=sparse %{dep:../tests/let_binding_spacing.ml}))))) + +(rule + (alias runtest) + (action (diff let_binding_spacing-sparse.ml.ref let_binding_spacing-sparse.ml.stdout))) + +(rule + (alias runtest) + (action (diff let_binding_spacing-sparse.ml.err let_binding_spacing-sparse.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to let_binding_spacing.ml.stdout + (with-stderr-to let_binding_spacing.ml.stderr + (run %{bin:ocamlformat} --name let_binding_spacing.ml --margin-check --let-binding-spacing=compact %{dep:../tests/let_binding_spacing.ml}))))) + +(rule + (alias runtest) + (action (diff let_binding_spacing.ml.ref let_binding_spacing.ml.stdout))) + +(rule + (alias runtest) + (action (diff let_binding_spacing.ml.err let_binding_spacing.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to let_in_constr.ml.stdout + (with-stderr-to let_in_constr.ml.stderr + (run %{bin:ocamlformat} --name let_in_constr.ml --margin-check %{dep:../tests/let_in_constr.ml}))))) + +(rule + (alias runtest) + (action (diff let_in_constr.ml.ref let_in_constr.ml.stdout))) + +(rule + (alias runtest) + (action (diff let_in_constr.ml.err let_in_constr.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to let_module-sparse.ml.stdout + (with-stderr-to let_module-sparse.ml.stderr + (run %{bin:ocamlformat} --name let_module-sparse.ml --margin-check --let-module=sparse %{dep:../tests/let_module.ml}))))) + +(rule + (alias runtest) + (action (diff let_module-sparse.ml.ref let_module-sparse.ml.stdout))) + +(rule + (alias runtest) + (action (diff let_module-sparse.ml.err let_module-sparse.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to let_module.ml.stdout + (with-stderr-to let_module.ml.stderr + (run %{bin:ocamlformat} --name let_module.ml --margin-check --let-module=compact %{dep:../tests/let_module.ml}))))) + +(rule + (alias runtest) + (action (diff let_module.ml.ref let_module.ml.stdout))) + +(rule + (alias runtest) + (action (diff let_module.ml.err let_module.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to let_punning.ml.stdout + (with-stderr-to let_punning.ml.stderr + (run %{bin:ocamlformat} --name let_punning.ml --margin-check %{dep:../tests/let_punning.ml}))))) + +(rule + (alias runtest) + (action (diff let_punning.ml.ref let_punning.ml.stdout))) + +(rule + (alias runtest) + (action (diff let_punning.ml.err let_punning.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to line_directives.ml.stdout + (with-stderr-to line_directives.ml.stderr + (with-accepted-exit-codes 1 + (run %{bin:ocamlformat} --name line_directives.ml --margin-check %{dep:../tests/line_directives.ml})))))) + +(rule + (alias runtest) + (action (diff line_directives.ml.ref line_directives.ml.stdout))) + +(rule + (alias runtest) + (action (diff line_directives.ml.err line_directives.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to list-space_around.ml.stdout + (with-stderr-to list-space_around.ml.stderr + (run %{bin:ocamlformat} --name list-space_around.ml --margin-check --space-around-arrays --space-around-lists --space-around-records --space-around-variants %{dep:../tests/list.ml}))))) + +(rule + (alias runtest) + (action (diff list-space_around.ml.ref list-space_around.ml.stdout))) + +(rule + (alias runtest) + (action (diff list-space_around.ml.err list-space_around.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to list.ml.stdout + (with-stderr-to list.ml.stderr + (run %{bin:ocamlformat} --name list.ml --margin-check %{dep:../tests/list.ml}))))) + +(rule + (alias runtest) + (action (diff list.ml.ref list.ml.stdout))) + +(rule + (alias runtest) + (action (diff list.ml.err list.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to list_and_comments.ml.stdout + (with-stderr-to list_and_comments.ml.stderr + (run %{bin:ocamlformat} --name list_and_comments.ml --margin-check %{dep:../tests/list_and_comments.ml}))))) + +(rule + (alias runtest) + (action (diff list_and_comments.ml.ref list_and_comments.ml.stdout))) + +(rule + (alias runtest) + (action (diff list_and_comments.ml.err list_and_comments.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to list_normalized.ml.stdout + (with-stderr-to list_normalized.ml.stderr + (run %{bin:ocamlformat} --name list_normalized.ml --margin-check --max-iters=4 %{dep:../tests/list_normalized.ml}))))) + +(rule + (alias runtest) + (action (diff list_normalized.ml.ref list_normalized.ml.stdout))) + +(rule + (alias runtest) + (action (diff list_normalized.ml.err list_normalized.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to loc_stack.ml.stdout + (with-stderr-to loc_stack.ml.stderr + (run %{bin:ocamlformat} --name loc_stack.ml --margin-check -n 3 %{dep:../tests/loc_stack.ml}))))) + +(rule + (alias runtest) + (action (diff loc_stack.ml.ref loc_stack.ml.stdout))) + +(rule + (alias runtest) + (action (diff loc_stack.ml.err loc_stack.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to locally_abtract_types.ml.stdout + (with-stderr-to locally_abtract_types.ml.stderr + (run %{bin:ocamlformat} --name locally_abtract_types.ml --margin-check %{dep:../tests/locally_abtract_types.ml}))))) + +(rule + (alias runtest) + (action (diff locally_abtract_types.ml.ref locally_abtract_types.ml.stdout))) + +(rule + (alias runtest) + (action (diff locally_abtract_types.ml.err locally_abtract_types.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to margin_80.ml.stdout + (with-stderr-to margin_80.ml.stderr + (run %{bin:ocamlformat} --name margin_80.ml --margin-check --margin=80 %{dep:../tests/margin_80.ml}))))) + +(rule + (alias runtest) + (action (diff margin_80.ml.ref margin_80.ml.stdout))) + +(rule + (alias runtest) + (action (diff margin_80.ml.err margin_80.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to match.ml.stdout + (with-stderr-to match.ml.stderr + (run %{bin:ocamlformat} --name match.ml --margin-check %{dep:../tests/match.ml}))))) + +(rule + (alias runtest) + (action (diff match.ml.ref match.ml.stdout))) + +(rule + (alias runtest) + (action (diff match.ml.err match.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to match2.ml.stdout + (with-stderr-to match2.ml.stderr + (run %{bin:ocamlformat} --name match2.ml --margin-check --leading-nested-match-parens %{dep:../tests/match2.ml}))))) + +(rule + (alias runtest) + (action (diff match2.ml.ref match2.ml.stdout))) + +(rule + (alias runtest) + (action (diff match2.ml.err match2.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to match_indent-never.ml.stdout + (with-stderr-to match_indent-never.ml.stderr + (run %{bin:ocamlformat} --name match_indent-never.ml --margin-check --match-indent=4 --match-indent-nested=never %{dep:../tests/match_indent.ml}))))) + +(rule + (alias runtest) + (action (diff match_indent-never.ml.ref match_indent-never.ml.stdout))) + +(rule + (alias runtest) + (action (diff match_indent-never.ml.err match_indent-never.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to match_indent.ml.stdout + (with-stderr-to match_indent.ml.stderr + (run %{bin:ocamlformat} --name match_indent.ml --margin-check --match-indent=4 --match-indent-nested=always %{dep:../tests/match_indent.ml}))))) + +(rule + (alias runtest) + (action (diff match_indent.ml.ref match_indent.ml.stdout))) + +(rule + (alias runtest) + (action (diff match_indent.ml.err match_indent.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to max_indent.ml.stdout + (with-stderr-to max_indent.ml.stderr + (run %{bin:ocamlformat} --name max_indent.ml --margin-check --max-indent=2 %{dep:../tests/max_indent.ml}))))) + +(rule + (alias runtest) + (action (diff max_indent.ml.ref max_indent.ml.stdout))) + +(rule + (alias runtest) + (action (diff max_indent.ml.err max_indent.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to mod_type_subst.ml.stdout + (with-stderr-to mod_type_subst.ml.stderr + (run %{bin:ocamlformat} --name mod_type_subst.ml --margin-check %{dep:../tests/mod_type_subst.ml}))))) + +(rule + (alias runtest) + (action (diff mod_type_subst.ml.ref mod_type_subst.ml.stdout))) + +(rule + (alias runtest) + (action (diff mod_type_subst.ml.err mod_type_subst.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to module.ml.stdout + (with-stderr-to module.ml.stderr + (run %{bin:ocamlformat} --name module.ml --margin-check %{dep:../tests/module.ml}))))) + +(rule + (alias runtest) + (action (diff module.ml.ref module.ml.stdout))) + +(rule + (alias runtest) + (action (diff module.ml.err module.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to module_anonymous.ml.stdout + (with-stderr-to module_anonymous.ml.stderr + (run %{bin:ocamlformat} --name module_anonymous.ml --margin-check %{dep:../tests/module_anonymous.ml}))))) + +(rule + (alias runtest) + (action (diff module_anonymous.ml.ref module_anonymous.ml.stdout))) + +(rule + (alias runtest) + (action (diff module_anonymous.ml.err module_anonymous.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to module_attributes.ml.stdout + (with-stderr-to module_attributes.ml.stderr + (run %{bin:ocamlformat} --name module_attributes.ml --margin-check %{dep:../tests/module_attributes.ml}))))) + +(rule + (alias runtest) + (action (diff module_attributes.ml.ref module_attributes.ml.stdout))) + +(rule + (alias runtest) + (action (diff module_attributes.ml.err module_attributes.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to module_item_spacing-preserve.ml.stdout + (with-stderr-to module_item_spacing-preserve.ml.stderr + (run %{bin:ocamlformat} --name module_item_spacing-preserve.ml --margin-check --max-iter=3 --module-item-spacing=preserve %{dep:../tests/module_item_spacing.ml}))))) + +(rule + (alias runtest) + (action (diff module_item_spacing-preserve.ml.ref module_item_spacing-preserve.ml.stdout))) + +(rule + (alias runtest) + (action (diff module_item_spacing-preserve.ml.err module_item_spacing-preserve.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to module_item_spacing-sparse.ml.stdout + (with-stderr-to module_item_spacing-sparse.ml.stderr + (run %{bin:ocamlformat} --name module_item_spacing-sparse.ml --margin-check --max-iter=3 --module-item-spacing=sparse %{dep:../tests/module_item_spacing.ml}))))) + +(rule + (alias runtest) + (action (diff module_item_spacing-sparse.ml.ref module_item_spacing-sparse.ml.stdout))) + +(rule + (alias runtest) + (action (diff module_item_spacing-sparse.ml.err module_item_spacing-sparse.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to module_item_spacing.ml.stdout + (with-stderr-to module_item_spacing.ml.stderr + (run %{bin:ocamlformat} --name module_item_spacing.ml --margin-check --max-iter=3 --module-item-spacing=compact %{dep:../tests/module_item_spacing.ml}))))) + +(rule + (alias runtest) + (action (diff module_item_spacing.ml.ref module_item_spacing.ml.stdout))) + +(rule + (alias runtest) + (action (diff module_item_spacing.ml.err module_item_spacing.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to module_item_spacing.mli.stdout + (with-stderr-to module_item_spacing.mli.stderr + (run %{bin:ocamlformat} --name module_item_spacing.mli --margin-check --max-iter=3 %{dep:../tests/module_item_spacing.mli}))))) + +(rule + (alias runtest) + (action (diff module_item_spacing.mli.ref module_item_spacing.mli.stdout))) + +(rule + (alias runtest) + (action (diff module_item_spacing.mli.err module_item_spacing.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to module_type.ml.stdout + (with-stderr-to module_type.ml.stderr + (run %{bin:ocamlformat} --name module_type.ml --margin-check %{dep:../tests/module_type.ml}))))) + +(rule + (alias runtest) + (action (diff module_type.ml.ref module_type.ml.stdout))) + +(rule + (alias runtest) + (action (diff module_type.ml.err module_type.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to module_type.mli.stdout + (with-stderr-to module_type.mli.stderr + (run %{bin:ocamlformat} --name module_type.mli --margin-check %{dep:../tests/module_type.mli}))))) + +(rule + (alias runtest) + (action (diff module_type.mli.ref module_type.mli.stdout))) + +(rule + (alias runtest) + (action (diff module_type.mli.err module_type.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to monadic_binding.ml.stdout + (with-stderr-to monadic_binding.ml.stderr + (run %{bin:ocamlformat} --name monadic_binding.ml --margin-check %{dep:../tests/monadic_binding.ml}))))) + +(rule + (alias runtest) + (action (diff monadic_binding.ml.ref monadic_binding.ml.stdout))) + +(rule + (alias runtest) + (action (diff monadic_binding.ml.err monadic_binding.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to multi_index_op.ml.stdout + (with-stderr-to multi_index_op.ml.stderr + (run %{bin:ocamlformat} --name multi_index_op.ml --margin-check %{dep:../tests/multi_index_op.ml}))))) + +(rule + (alias runtest) + (action (diff multi_index_op.ml.ref multi_index_op.ml.stdout))) + +(rule + (alias runtest) + (action (diff multi_index_op.ml.err multi_index_op.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to named_existentials.ml.stdout + (with-stderr-to named_existentials.ml.stderr + (run %{bin:ocamlformat} --name named_existentials.ml --margin-check %{dep:../tests/named_existentials.ml}))))) + +(rule + (alias runtest) + (action (diff named_existentials.ml.ref named_existentials.ml.stdout))) + +(rule + (alias runtest) + (action (diff named_existentials.ml.err named_existentials.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to need_format.ml.stdout + (with-stderr-to need_format.ml.stderr + (with-accepted-exit-codes 1 + (run %{bin:ocamlformat} --name need_format.ml --margin-check --max-iters=1 %{dep:../tests/need_format.ml})))))) + +(rule + (alias runtest) + (action (diff need_format.ml.ref need_format.ml.stdout))) + +(rule + (alias runtest) + (action (diff need_format.ml.err need_format.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to new.ml.stdout + (with-stderr-to new.ml.stderr + (run %{bin:ocamlformat} --name new.ml --margin-check %{dep:../tests/new.ml}))))) + +(rule + (alias runtest) + (action (diff new.ml.ref new.ml.stdout))) + +(rule + (alias runtest) + (action (diff new.ml.err new.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to object.ml.stdout + (with-stderr-to object.ml.stderr + (run %{bin:ocamlformat} --name object.ml --margin-check %{dep:../tests/object.ml}))))) + +(rule + (alias runtest) + (action (diff object.ml.ref object.ml.stdout))) + +(rule + (alias runtest) + (action (diff object.ml.err object.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to object2.ml.stdout + (with-stderr-to object2.ml.stderr + (run %{bin:ocamlformat} --name object2.ml --margin-check %{dep:../tests/object2.ml}))))) + +(rule + (alias runtest) + (action (diff object2.ml.ref object2.ml.stdout))) + +(rule + (alias runtest) + (action (diff object2.ml.err object2.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to object_expr-414.ml.stdout + (with-stderr-to object_expr-414.ml.stderr + (run %{bin:ocamlformat} --name object_expr-414.ml --margin-check --ocaml-version=4.14.0 %{dep:../tests/object_expr.ml}))))) + +(rule + (alias runtest) + (action (diff object_expr-414.ml.ref object_expr-414.ml.stdout))) + +(rule + (alias runtest) + (action (diff object_expr-414.ml.err object_expr-414.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to object_expr.ml.stdout + (with-stderr-to object_expr.ml.stderr + (run %{bin:ocamlformat} --name object_expr.ml --margin-check %{dep:../tests/object_expr.ml}))))) + +(rule + (alias runtest) + (action (diff object_expr.ml.ref object_expr.ml.stdout))) + +(rule + (alias runtest) + (action (diff object_expr.ml.err object_expr.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to object_type.ml.stdout + (with-stderr-to object_type.ml.stderr + (run %{bin:ocamlformat} --name object_type.ml --margin-check %{dep:../tests/object_type.ml}))))) + +(rule + (alias runtest) + (action (diff object_type.ml.ref object_type.ml.stdout))) + +(rule + (alias runtest) + (action (diff object_type.ml.err object_type.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to obuild.ml.stdout + (with-stderr-to obuild.ml.stderr + (run %{bin:ocamlformat} --name obuild.ml --margin-check %{dep:../tests/obuild.ml}))))) + +(rule + (alias runtest) + (action (diff obuild.ml.ref obuild.ml.stdout))) + +(rule + (alias runtest) + (action (diff obuild.ml.err obuild.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ocp_indent_compat-break_colon_after.ml.stdout + (with-stderr-to ocp_indent_compat-break_colon_after.ml.stderr + (run %{bin:ocamlformat} --name ocp_indent_compat-break_colon_after.ml --margin-check --ocp-indent-compat --break-colon=after %{dep:../tests/ocp_indent_compat.ml}))))) + +(rule + (alias runtest) + (action (diff ocp_indent_compat-break_colon_after.ml.ref ocp_indent_compat-break_colon_after.ml.stdout))) + +(rule + (alias runtest) + (action (diff ocp_indent_compat-break_colon_after.ml.err ocp_indent_compat-break_colon_after.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ocp_indent_compat.ml.stdout + (with-stderr-to ocp_indent_compat.ml.stderr + (run %{bin:ocamlformat} --name ocp_indent_compat.ml --margin-check --ocp-indent-compat --break-colon=before %{dep:../tests/ocp_indent_compat.ml}))))) + +(rule + (alias runtest) + (action (diff ocp_indent_compat.ml.ref ocp_indent_compat.ml.stdout))) + +(rule + (alias runtest) + (action (diff ocp_indent_compat.ml.err ocp_indent_compat.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to ocp_indent_options.ml.stdout + (with-stderr-to ocp_indent_options.ml.stderr + (run %{bin:ocamlformat} --name ocp_indent_options.ml --margin-check --ocp-indent-config %{dep:../tests/ocp_indent_options.ml}))))) + +(rule + (alias runtest) + (action (diff ocp_indent_options.ml.ref ocp_indent_options.ml.stdout))) + +(rule + (alias runtest) + (action (diff ocp_indent_options.ml.err ocp_indent_options.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to open-closing-on-separate-line.ml.stdout + (with-stderr-to open-closing-on-separate-line.ml.stderr + (run %{bin:ocamlformat} --name open-closing-on-separate-line.ml --margin-check --indicate-multiline-delimiters=closing-on-separate-line %{dep:../tests/open.ml}))))) + +(rule + (alias runtest) + (action (diff open-closing-on-separate-line.ml.ref open-closing-on-separate-line.ml.stdout))) + +(rule + (alias runtest) + (action (diff open-closing-on-separate-line.ml.err open-closing-on-separate-line.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to open.ml.stdout + (with-stderr-to open.ml.stderr + (run %{bin:ocamlformat} --name open.ml --margin-check %{dep:../tests/open.ml}))))) + +(rule + (alias runtest) + (action (diff open.ml.ref open.ml.stdout))) + +(rule + (alias runtest) + (action (diff open.ml.err open.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to open_types.ml.stdout + (with-stderr-to open_types.ml.stderr + (run %{bin:ocamlformat} --name open_types.ml --margin-check %{dep:../tests/open_types.ml}))))) + +(rule + (alias runtest) + (action (diff open_types.ml.ref open_types.ml.stdout))) + +(rule + (alias runtest) + (action (diff open_types.ml.err open_types.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to option.ml.stdout + (with-stderr-to option.ml.stderr + (run %{bin:ocamlformat} --name option.ml --margin-check %{dep:../tests/option.ml}))))) + +(rule + (alias runtest) + (action (diff option.ml.ref option.ml.stdout))) + +(rule + (alias runtest) + (action (diff option.ml.err option.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to override.ml.stdout + (with-stderr-to override.ml.stderr + (run %{bin:ocamlformat} --name override.ml --margin-check %{dep:../tests/override.ml}))))) + +(rule + (alias runtest) + (action (diff override.ml.ref override.ml.stdout))) + +(rule + (alias runtest) + (action (diff override.ml.err override.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to parens_tuple_patterns.ml.stdout + (with-stderr-to parens_tuple_patterns.ml.stderr + (run %{bin:ocamlformat} --name parens_tuple_patterns.ml --margin-check %{dep:../tests/parens_tuple_patterns.ml}))))) + +(rule + (alias runtest) + (action (diff parens_tuple_patterns.ml.ref parens_tuple_patterns.ml.stdout))) + +(rule + (alias runtest) + (action (diff parens_tuple_patterns.ml.err parens_tuple_patterns.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to polytypes.ml.stdout + (with-stderr-to polytypes.ml.stderr + (run %{bin:ocamlformat} --name polytypes.ml --margin-check %{dep:../tests/polytypes.ml}))))) + +(rule + (alias runtest) + (action (diff polytypes.ml.ref polytypes.ml.stdout))) + +(rule + (alias runtest) + (action (diff polytypes.ml.err polytypes.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to pre_post_extensions.ml.stdout + (with-stderr-to pre_post_extensions.ml.stderr + (run %{bin:ocamlformat} --name pre_post_extensions.ml --margin-check %{dep:../tests/pre_post_extensions.ml}))))) + +(rule + (alias runtest) + (action (diff pre_post_extensions.ml.ref pre_post_extensions.ml.stdout))) + +(rule + (alias runtest) + (action (diff pre_post_extensions.ml.err pre_post_extensions.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to precedence.ml.stdout + (with-stderr-to precedence.ml.stderr + (run %{bin:ocamlformat} --name precedence.ml --margin-check %{dep:../tests/precedence.ml}))))) + +(rule + (alias runtest) + (action (diff precedence.ml.ref precedence.ml.stdout))) + +(rule + (alias runtest) + (action (diff precedence.ml.err precedence.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to prefix_infix.ml.stdout + (with-stderr-to prefix_infix.ml.stderr + (run %{bin:ocamlformat} --name prefix_infix.ml --margin-check %{dep:../tests/prefix_infix.ml}))))) + +(rule + (alias runtest) + (action (diff prefix_infix.ml.ref prefix_infix.ml.stdout))) + +(rule + (alias runtest) + (action (diff prefix_infix.ml.err prefix_infix.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to profiles.ml.stdout + (with-stderr-to profiles.ml.stderr + (run %{bin:ocamlformat} --name profiles.ml --margin-check --config=margin=20 --module-item-spacing=sparse %{dep:../tests/profiles.ml}))))) + +(rule + (alias runtest) + (action (diff profiles.ml.ref profiles.ml.stdout))) + +(rule + (alias runtest) + (action (diff profiles.ml.err profiles.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to profiles2.ml.stdout + (with-stderr-to profiles2.ml.stderr + (run %{bin:ocamlformat} --name profiles2.ml --margin-check %{dep:../tests/profiles2.ml}))))) + +(rule + (alias runtest) + (action (diff profiles2.ml.ref profiles2.ml.stdout))) + +(rule + (alias runtest) + (action (diff profiles2.ml.err profiles2.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to protected_object_types.ml.stdout + (with-stderr-to protected_object_types.ml.stderr + (run %{bin:ocamlformat} --name protected_object_types.ml --margin-check %{dep:../tests/protected_object_types.ml}))))) + +(rule + (alias runtest) + (action (diff protected_object_types.ml.ref protected_object_types.ml.stdout))) + +(rule + (alias runtest) + (action (diff protected_object_types.ml.err protected_object_types.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to qtest.ml.stdout + (with-stderr-to qtest.ml.stderr + (run %{bin:ocamlformat} --name qtest.ml --margin-check %{dep:../tests/qtest.ml}))))) + +(rule + (alias runtest) + (action (diff qtest.ml.ref qtest.ml.stdout))) + +(rule + (alias runtest) + (action (diff qtest.ml.err qtest.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to quoted_strings.ml.stdout + (with-stderr-to quoted_strings.ml.stderr + (run %{bin:ocamlformat} --name quoted_strings.ml --margin-check %{dep:../tests/quoted_strings.ml}))))) + +(rule + (alias runtest) + (action (diff quoted_strings.ml.ref quoted_strings.ml.stdout))) + +(rule + (alias runtest) + (action (diff quoted_strings.ml.err quoted_strings.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to recmod.mli.stdout + (with-stderr-to recmod.mli.stderr + (run %{bin:ocamlformat} --name recmod.mli --margin-check %{dep:../tests/recmod.mli}))))) + +(rule + (alias runtest) + (action (diff recmod.mli.ref recmod.mli.stdout))) + +(rule + (alias runtest) + (action (diff recmod.mli.err recmod.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to record-402.ml.stdout + (with-stderr-to record-402.ml.stderr + (run %{bin:ocamlformat} --name record-402.ml --margin-check --ocaml-version=4.02 %{dep:../tests/record.ml}))))) + +(rule + (alias runtest) + (action (diff record-402.ml.ref record-402.ml.stdout))) + +(rule + (alias runtest) + (action (diff record-402.ml.err record-402.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to record-loose.ml.stdout + (with-stderr-to record-loose.ml.stderr + (run %{bin:ocamlformat} --name record-loose.ml --margin-check --field-space=loose %{dep:../tests/record.ml}))))) + +(rule + (alias runtest) + (action (diff record-loose.ml.ref record-loose.ml.stdout))) + +(rule + (alias runtest) + (action (diff record-loose.ml.err record-loose.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to record-tight_decl.ml.stdout + (with-stderr-to record-tight_decl.ml.stderr + (run %{bin:ocamlformat} --name record-tight_decl.ml --margin-check --field-space=tight-decl %{dep:../tests/record.ml}))))) + +(rule + (alias runtest) + (action (diff record-tight_decl.ml.ref record-tight_decl.ml.stdout))) + +(rule + (alias runtest) + (action (diff record-tight_decl.ml.err record-tight_decl.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to record.ml.stdout + (with-stderr-to record.ml.stderr + (run %{bin:ocamlformat} --name record.ml --margin-check --field-space=tight %{dep:../tests/record.ml}))))) + +(rule + (alias runtest) + (action (diff record.ml.ref record.ml.stdout))) + +(rule + (alias runtest) + (action (diff record.ml.err record.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to record_punning.ml.stdout + (with-stderr-to record_punning.ml.stderr + (run %{bin:ocamlformat} --name record_punning.ml --margin-check %{dep:../tests/record_punning.ml}))))) + +(rule + (alias runtest) + (action (diff record_punning.ml.ref record_punning.ml.stdout))) + +(rule + (alias runtest) + (action (diff record_punning.ml.err record_punning.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to reformat_string.ml.stdout + (with-stderr-to reformat_string.ml.stderr + (run %{bin:ocamlformat} --name reformat_string.ml --margin-check --max-iter=3 %{dep:../tests/reformat_string.ml}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff reformat_string.ml.ref reformat_string.ml.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff reformat_string.ml.err reformat_string.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to refs.ml.stdout + (with-stderr-to refs.ml.stderr + (run %{bin:ocamlformat} --name refs.ml --margin-check %{dep:../tests/refs.ml}))))) + +(rule + (alias runtest) + (action (diff refs.ml.ref refs.ml.stdout))) + +(rule + (alias runtest) + (action (diff refs.ml.err refs.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to remove_extra_parens.ml.stdout + (with-stderr-to remove_extra_parens.ml.stderr + (run %{bin:ocamlformat} --name remove_extra_parens.ml --margin-check %{dep:../tests/remove_extra_parens.ml}))))) + +(rule + (alias runtest) + (action (diff remove_extra_parens.ml.ref remove_extra_parens.ml.stdout))) + +(rule + (alias runtest) + (action (diff remove_extra_parens.ml.err remove_extra_parens.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to repl.ml.stdout + (with-stderr-to repl.ml.stderr + (run %{bin:ocamlformat} --name repl.ml --margin-check --parse-toplevel-phrases --repl-file %{dep:../tests/repl.ml}))))) + +(rule + (alias runtest) + (action (diff repl.ml.ref repl.ml.stdout))) + +(rule + (alias runtest) + (action (diff repl.ml.err repl.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to repl.mli.stdout + (with-stderr-to repl.mli.stderr + (run %{bin:ocamlformat} --name repl.mli --margin-check --parse-toplevel-phrases %{dep:../tests/repl.mli}))))) + +(rule + (alias runtest) + (action (diff repl.mli.ref repl.mli.stdout))) + +(rule + (alias runtest) + (action (diff repl.mli.err repl.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to revapply_ext.ml.stdout + (with-stderr-to revapply_ext.ml.stderr + (run %{bin:ocamlformat} --name revapply_ext.ml --margin-check %{dep:../tests/revapply_ext.ml}))))) + +(rule + (alias runtest) + (action (diff revapply_ext.ml.ref revapply_ext.ml.stdout))) + +(rule + (alias runtest) + (action (diff revapply_ext.ml.err revapply_ext.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to send.ml.stdout + (with-stderr-to send.ml.stderr + (run %{bin:ocamlformat} --name send.ml --margin-check %{dep:../tests/send.ml}))))) + +(rule + (alias runtest) + (action (diff send.ml.ref send.ml.stdout))) + +(rule + (alias runtest) + (action (diff send.ml.err send.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to sequence-preserve.ml.stdout + (with-stderr-to sequence-preserve.ml.stderr + (run %{bin:ocamlformat} --name sequence-preserve.ml --margin-check --sequence-blank-line=preserve-one --max-iter=3 %{dep:../tests/sequence.ml}))))) + +(rule + (alias runtest) + (action (diff sequence-preserve.ml.ref sequence-preserve.ml.stdout))) + +(rule + (alias runtest) + (action (diff sequence-preserve.ml.err sequence-preserve.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to sequence.ml.stdout + (with-stderr-to sequence.ml.stderr + (run %{bin:ocamlformat} --name sequence.ml --margin-check --sequence-blank-line=compact %{dep:../tests/sequence.ml}))))) + +(rule + (alias runtest) + (action (diff sequence.ml.ref sequence.ml.stdout))) + +(rule + (alias runtest) + (action (diff sequence.ml.err sequence.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to shebang.ml.stdout + (with-stderr-to shebang.ml.stderr + (run %{bin:ocamlformat} --name shebang.ml --margin-check %{dep:../tests/shebang.ml}))))) + +(rule + (alias runtest) + (action (diff shebang.ml.ref shebang.ml.stdout))) + +(rule + (alias runtest) + (action (diff shebang.ml.err shebang.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to shortcut_ext_attr.ml.stdout + (with-stderr-to shortcut_ext_attr.ml.stderr + (run %{bin:ocamlformat} --name shortcut_ext_attr.ml --margin-check %{dep:../tests/shortcut_ext_attr.ml}))))) + +(rule + (alias runtest) + (action (diff shortcut_ext_attr.ml.ref shortcut_ext_attr.ml.stdout))) + +(rule + (alias runtest) + (action (diff shortcut_ext_attr.ml.err shortcut_ext_attr.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to sig_value.mli.stdout + (with-stderr-to sig_value.mli.stderr + (run %{bin:ocamlformat} --name sig_value.mli --margin-check %{dep:../tests/sig_value.mli}))))) + +(rule + (alias runtest) + (action (diff sig_value.mli.ref sig_value.mli.stdout))) + +(rule + (alias runtest) + (action (diff sig_value.mli.err sig_value.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to single_line.mli.stdout + (with-stderr-to single_line.mli.stderr + (run %{bin:ocamlformat} --name single_line.mli --margin-check %{dep:../tests/single_line.mli}))))) + +(rule + (alias runtest) + (action (diff single_line.mli.ref single_line.mli.stdout))) + +(rule + (alias runtest) + (action (diff single_line.mli.err single_line.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to skip.ml.stdout + (with-stderr-to skip.ml.stderr + (run %{bin:ocamlformat} --name skip.ml --margin-check %{dep:../tests/skip.ml}))))) + +(rule + (alias runtest) + (action (diff skip.ml.ref skip.ml.stdout))) + +(rule + (alias runtest) + (action (diff skip.ml.err skip.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to source.ml.stdout + (with-stderr-to source.ml.stderr + (run %{bin:ocamlformat} --name source.ml --margin-check --max-iters=3 %{dep:../tests/source.ml}))))) + +(rule + (alias runtest) + (action (diff source.ml.ref source.ml.stdout))) + +(rule + (alias runtest) + (action (diff source.ml.err source.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to str_value.ml.stdout + (with-stderr-to str_value.ml.stderr + (run %{bin:ocamlformat} --name str_value.ml --margin-check %{dep:../tests/str_value.ml}))))) + +(rule + (alias runtest) + (action (diff str_value.ml.ref str_value.ml.stdout))) + +(rule + (alias runtest) + (action (diff str_value.ml.err str_value.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to string.ml.stdout + (with-stderr-to string.ml.stderr + (run %{bin:ocamlformat} --name string.ml --margin-check %{dep:../tests/string.ml}))))) + +(rule + (alias runtest) + (action (diff string.ml.ref string.ml.stdout))) + +(rule + (alias runtest) + (action (diff string.ml.err string.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to string_array.ml.stdout + (with-stderr-to string_array.ml.stderr + (run %{bin:ocamlformat} --name string_array.ml --margin-check %{dep:../tests/string_array.ml}))))) + +(rule + (alias runtest) + (action (diff string_array.ml.ref string_array.ml.stdout))) + +(rule + (alias runtest) + (action (diff string_array.ml.err string_array.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to string_wrapping.ml.stdout + (with-stderr-to string_wrapping.ml.stderr + (run %{bin:ocamlformat} --name string_wrapping.ml --margin-check %{dep:../tests/string_wrapping.ml}))))) + +(rule + (alias runtest) + (action (diff string_wrapping.ml.ref string_wrapping.ml.stdout))) + +(rule + (alias runtest) + (action (diff string_wrapping.ml.err string_wrapping.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to symbol.ml.stdout + (with-stderr-to symbol.ml.stderr + (run %{bin:ocamlformat} --name symbol.ml --margin-check %{dep:../tests/symbol.ml}))))) + +(rule + (alias runtest) + (action (diff symbol.ml.ref symbol.ml.stdout))) + +(rule + (alias runtest) + (action (diff symbol.ml.err symbol.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to tag_only.ml.stdout + (with-stderr-to tag_only.ml.stderr + (run %{bin:ocamlformat} --name tag_only.ml --margin-check %{dep:../tests/tag_only.ml}))))) + +(rule + (alias runtest) + (action (diff tag_only.ml.ref tag_only.ml.stdout))) + +(rule + (alias runtest) + (action (diff tag_only.ml.err tag_only.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to tag_only.mli.stdout + (with-stderr-to tag_only.mli.stderr + (run %{bin:ocamlformat} --name tag_only.mli --margin-check %{dep:../tests/tag_only.mli}))))) + +(rule + (alias runtest) + (action (diff tag_only.mli.ref tag_only.mli.stdout))) + +(rule + (alias runtest) + (action (diff tag_only.mli.err tag_only.mli.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to try_with_or_pattern.ml.stdout + (with-stderr-to try_with_or_pattern.ml.stderr + (run %{bin:ocamlformat} --name try_with_or_pattern.ml --margin-check %{dep:../tests/try_with_or_pattern.ml}))))) + +(rule + (alias runtest) + (action (diff try_with_or_pattern.ml.ref try_with_or_pattern.ml.stdout))) + +(rule + (alias runtest) + (action (diff try_with_or_pattern.ml.err try_with_or_pattern.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to tuple.ml.stdout + (with-stderr-to tuple.ml.stderr + (run %{bin:ocamlformat} --name tuple.ml --margin-check --parens-tuple=always %{dep:../tests/tuple.ml}))))) + +(rule + (alias runtest) + (action (diff tuple.ml.ref tuple.ml.stdout))) + +(rule + (alias runtest) + (action (diff tuple.ml.err tuple.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to tuple_less_parens.ml.stdout + (with-stderr-to tuple_less_parens.ml.stderr + (run %{bin:ocamlformat} --name tuple_less_parens.ml --margin-check --parens-tuple=multi-line-only %{dep:../tests/tuple_less_parens.ml}))))) + +(rule + (alias runtest) + (action (diff tuple_less_parens.ml.ref tuple_less_parens.ml.stdout))) + +(rule + (alias runtest) + (action (diff tuple_less_parens.ml.err tuple_less_parens.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to tuple_type_parens.ml.stdout + (with-stderr-to tuple_type_parens.ml.stderr + (run %{bin:ocamlformat} --name tuple_type_parens.ml --margin-check %{dep:../tests/tuple_type_parens.ml}))))) + +(rule + (alias runtest) + (action (diff tuple_type_parens.ml.ref tuple_type_parens.ml.stdout))) + +(rule + (alias runtest) + (action (diff tuple_type_parens.ml.err tuple_type_parens.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to type_and_constraint.ml.stdout + (with-stderr-to type_and_constraint.ml.stderr + (run %{bin:ocamlformat} --name type_and_constraint.ml --margin-check %{dep:../tests/type_and_constraint.ml}))))) + +(rule + (alias runtest) + (action (diff type_and_constraint.ml.ref type_and_constraint.ml.stdout))) + +(rule + (alias runtest) + (action (diff type_and_constraint.ml.err type_and_constraint.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to type_annotations.ml.stdout + (with-stderr-to type_annotations.ml.stderr + (run %{bin:ocamlformat} --name type_annotations.ml --margin-check %{dep:../tests/type_annotations.ml}))))) + +(rule + (alias runtest) + (action (diff type_annotations.ml.ref type_annotations.ml.stdout))) + +(rule + (alias runtest) + (action (diff type_annotations.ml.err type_annotations.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to types-compact-space_around-docked.ml.stdout + (with-stderr-to types-compact-space_around-docked.ml.stderr + (run %{bin:ocamlformat} --name types-compact-space_around-docked.ml --margin-check --type-decl=compact --space-around-arrays --space-around-lists --space-around-records --space-around-variants --break-separators=after --dock-collection-brackets %{dep:../tests/types.ml}))))) + +(rule + (alias runtest) + (action (diff types-compact-space_around-docked.ml.ref types-compact-space_around-docked.ml.stdout))) + +(rule + (alias runtest) + (action (diff types-compact-space_around-docked.ml.err types-compact-space_around-docked.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to types-compact-space_around.ml.stdout + (with-stderr-to types-compact-space_around.ml.stderr + (run %{bin:ocamlformat} --name types-compact-space_around.ml --margin-check --type-decl=compact --space-around-arrays --space-around-lists --space-around-records --space-around-variants %{dep:../tests/types.ml}))))) + +(rule + (alias runtest) + (action (diff types-compact-space_around.ml.ref types-compact-space_around.ml.stdout))) + +(rule + (alias runtest) + (action (diff types-compact-space_around.ml.err types-compact-space_around.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to types-compact.ml.stdout + (with-stderr-to types-compact.ml.stderr + (run %{bin:ocamlformat} --name types-compact.ml --margin-check --type-decl=compact %{dep:../tests/types.ml}))))) + +(rule + (alias runtest) + (action (diff types-compact.ml.ref types-compact.ml.stdout))) + +(rule + (alias runtest) + (action (diff types-compact.ml.err types-compact.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to types-indent.ml.stdout + (with-stderr-to types-indent.ml.stderr + (run %{bin:ocamlformat} --name types-indent.ml --margin-check --type-decl-indent=6 %{dep:../tests/types.ml}))))) + +(rule + (alias runtest) + (action (diff types-indent.ml.ref types-indent.ml.stdout))) + +(rule + (alias runtest) + (action (diff types-indent.ml.err types-indent.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to types-sparse-space_around.ml.stdout + (with-stderr-to types-sparse-space_around.ml.stderr + (run %{bin:ocamlformat} --name types-sparse-space_around.ml --margin-check --type-decl=sparse --space-around-arrays --space-around-lists --space-around-records --space-around-variants %{dep:../tests/types.ml}))))) + +(rule + (alias runtest) + (action (diff types-sparse-space_around.ml.ref types-sparse-space_around.ml.stdout))) + +(rule + (alias runtest) + (action (diff types-sparse-space_around.ml.err types-sparse-space_around.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to types-sparse.ml.stdout + (with-stderr-to types-sparse.ml.stderr + (run %{bin:ocamlformat} --name types-sparse.ml --margin-check --type-decl=sparse %{dep:../tests/types.ml}))))) + +(rule + (alias runtest) + (action (diff types-sparse.ml.ref types-sparse.ml.stdout))) + +(rule + (alias runtest) + (action (diff types-sparse.ml.err types-sparse.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to types.ml.stdout + (with-stderr-to types.ml.stderr + (run %{bin:ocamlformat} --name types.ml --margin-check %{dep:../tests/types.ml}))))) + +(rule + (alias runtest) + (action (diff types.ml.ref types.ml.stdout))) + +(rule + (alias runtest) + (action (diff types.ml.err types.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to unary.ml.stdout + (with-stderr-to unary.ml.stderr + (run %{bin:ocamlformat} --name unary.ml --margin-check %{dep:../tests/unary.ml}))))) + +(rule + (alias runtest) + (action (diff unary.ml.ref unary.ml.stdout))) + +(rule + (alias runtest) + (action (diff unary.ml.err unary.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to unary_hash.ml.stdout + (with-stderr-to unary_hash.ml.stderr + (run %{bin:ocamlformat} --name unary_hash.ml --margin-check %{dep:../tests/unary_hash.ml}))))) + +(rule + (alias runtest) + (action (diff unary_hash.ml.ref unary_hash.ml.stdout))) + +(rule + (alias runtest) + (action (diff unary_hash.ml.err unary_hash.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to unicode.ml.stdout + (with-stderr-to unicode.ml.stderr + (run %{bin:ocamlformat} --name unicode.ml --margin-check --margin=80 --wrap-comments %{dep:../tests/unicode.ml}))))) + +(rule + (alias runtest) + (action (diff unicode.ml.ref unicode.ml.stdout))) + +(rule + (alias runtest) + (action (diff unicode.ml.err unicode.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to use_file.mlt.stdout + (with-stderr-to use_file.mlt.stderr + (run %{bin:ocamlformat} --name use_file.mlt --margin-check %{dep:../tests/use_file.mlt}))))) + +(rule + (alias runtest) + (action (diff use_file.mlt.ref use_file.mlt.stdout))) + +(rule + (alias runtest) + (action (diff use_file.mlt.err use_file.mlt.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to variants.ml.stdout + (with-stderr-to variants.ml.stderr + (run %{bin:ocamlformat} --name variants.ml --margin-check %{dep:../tests/variants.ml}))))) + +(rule + (alias runtest) + (action (diff variants.ml.ref variants.ml.stdout))) + +(rule + (alias runtest) + (action (diff variants.ml.err variants.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to verbatim_comments-wrap.ml.stdout + (with-stderr-to verbatim_comments-wrap.ml.stderr + (run %{bin:ocamlformat} --name verbatim_comments-wrap.ml --margin-check --wrap-comments %{dep:../tests/verbatim_comments.ml}))))) + +(rule + (alias runtest) + (action (diff verbatim_comments-wrap.ml.ref verbatim_comments-wrap.ml.stdout))) + +(rule + (alias runtest) + (action (diff verbatim_comments-wrap.ml.err verbatim_comments-wrap.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to verbatim_comments.ml.stdout + (with-stderr-to verbatim_comments.ml.stderr + (run %{bin:ocamlformat} --name verbatim_comments.ml --margin-check %{dep:../tests/verbatim_comments.ml}))))) + +(rule + (alias runtest) + (action (diff verbatim_comments.ml.ref verbatim_comments.ml.stdout))) + +(rule + (alias runtest) + (action (diff verbatim_comments.ml.err verbatim_comments.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to w50.ml.stdout + (with-stderr-to w50.ml.stderr + (run %{bin:ocamlformat} --name w50.ml --margin-check --no-comment-check -q --max-iters=3 %{dep:../tests/w50.ml}))))) + +(rule + (alias runtest) + (action (diff w50.ml.ref w50.ml.stdout))) + +(rule + (alias runtest) + (action (diff w50.ml.err w50.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (enabled_if (<> %{os_type} Win32)) + (action + (with-stdout-to wrap_comments.ml.stdout + (with-stderr-to wrap_comments.ml.stderr + (run %{bin:ocamlformat} --name wrap_comments.ml --margin-check --max-iters=3 %{dep:../tests/wrap_comments.ml}))))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff wrap_comments.ml.ref wrap_comments.ml.stdout))) + +(rule + (alias runtest) + (enabled_if (<> %{os_type} Win32)) + (action (diff wrap_comments.ml.err wrap_comments.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to wrap_comments_break.ml.stdout + (with-stderr-to wrap_comments_break.ml.stderr + (run %{bin:ocamlformat} --name wrap_comments_break.ml --margin-check --no-wrap-fun-args --margin=67 %{dep:../tests/wrap_comments_break.ml}))))) + +(rule + (alias runtest) + (action (diff wrap_comments_break.ml.ref wrap_comments_break.ml.stdout))) + +(rule + (alias runtest) + (action (diff wrap_comments_break.ml.err wrap_comments_break.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to wrap_invalid_doc_comments.ml.stdout + (with-stderr-to wrap_invalid_doc_comments.ml.stderr + (run %{bin:ocamlformat} --name wrap_invalid_doc_comments.ml --margin-check --parse-docstrings --wrap-comments %{dep:../tests/wrap_invalid_doc_comments.ml}))))) + +(rule + (alias runtest) + (action (diff wrap_invalid_doc_comments.ml.ref wrap_invalid_doc_comments.ml.stdout))) + +(rule + (alias runtest) + (action (diff wrap_invalid_doc_comments.ml.err wrap_invalid_doc_comments.ml.stderr))) + +(rule + (deps .ocamlformat dune-project) + (action + (with-stdout-to wrapping_functor_args.ml.stdout + (with-stderr-to wrapping_functor_args.ml.stderr + (run %{bin:ocamlformat} --name wrapping_functor_args.ml --margin-check %{dep:../tests/wrapping_functor_args.ml}))))) + +(rule + (alias runtest) + (action (diff wrapping_functor_args.ml.ref wrapping_functor_args.ml.stdout))) + +(rule + (alias runtest) + (action (diff wrapping_functor_args.ml.err wrapping_functor_args.ml.stderr))) diff --git a/test/passing/gen/gen.ml b/test/passing/gen/gen.ml index 1f8dca695c..04c0ac1ae4 100644 --- a/test/passing/gen/gen.ml +++ b/test/passing/gen/gen.ml @@ -1,3 +1,9 @@ +(** Generates Dune rules for running the tests. The [tests/] directory contains + the source files for the tests. The output of the tests is promoted to the + corresponding [refs.*/] directory for each profiles. *) + +let input_dir = "../tests/" + module StringMap = Map.Make (String) let spf = Printf.sprintf @@ -5,12 +11,8 @@ let spf = Printf.sprintf let dep fname = spf "%%{dep:%s}" fname type setup = - { mutable has_ref: bool - ; mutable has_opts: bool - ; mutable has_ocp: bool - ; mutable ocp_opts: string list + { mutable has_opts: bool ; mutable base_file: string option - ; mutable extra_deps: string list ; mutable should_fail: bool ; mutable enabled_if: string option } @@ -40,14 +42,7 @@ let read_file file = let add_test ?base_file map src_test_name = let s = - { has_ref= false - ; has_opts= false - ; has_ocp= false - ; ocp_opts= [] - ; base_file - ; extra_deps= [] - ; should_fail= false - ; enabled_if= None } + {has_opts= false; base_file; should_fail= false; enabled_if= None} in map := StringMap.add src_test_name s !map ; s @@ -57,7 +52,7 @@ let register_file tests fname = | test_name :: (("ml" | "mli" | "mlt" | "mld" | "eliom" | "eliomi") as ext) :: rest -> ( - let fname = "tests/" ^ fname in + let fname = input_dir ^ fname in let src_test_name = test_name ^ "." ^ ext in let setup = match StringMap.find src_test_name !tests with @@ -72,12 +67,8 @@ let register_file tests fname = in match rest with | [] -> () - | ["output"] | ["ocp"; "output"] -> () + | ["output"] -> () | ["opts"] -> setup.has_opts <- true - | ["ref"] -> setup.has_ref <- true - | ["ocp"] -> setup.has_ocp <- true - | ["ocp-opts"] -> setup.ocp_opts <- read_lines fname - | ["deps"] -> setup.extra_deps <- read_lines fname | ["should-fail"] -> setup.should_fail <- true | ["enabled-if"] -> setup.enabled_if <- Some (read_file fname) | ["err"] -> () @@ -95,30 +86,27 @@ let cmd should_fail args = let emit_test test_name setup = let opts = - "--margin-check" + (* Pass a relative file name to [--name] so that the right config is + picked in [refs.*/.ocamlformat], this is not the input path. *) + "--name" :: test_name :: "--margin-check" :: - ( if setup.has_opts then read_lines (spf "tests/%s.opts" test_name) + ( if setup.has_opts then read_lines (spf "%s/%s.opts" input_dir test_name) else [] ) in - let ref_name = - "tests/" ^ if setup.has_ref then test_name ^ ".ref" else test_name - in - let err_name = "tests/" ^ test_name ^ ".err" in + let ref_file ext = test_name ^ ext in let base_test_name = - "tests/" ^ match setup.base_file with Some n -> n | None -> test_name + input_dir ^ match setup.base_file with Some n -> n | None -> test_name in - let extra_deps = String.concat " " setup.extra_deps in let enabled_if_line = match setup.enabled_if with | None -> "" | Some clause -> spf "\n (enabled_if %s)" clause in - let output_fname = test_name ^ ".stdout" in + let output_fname = ref_file ".stdout" in Printf.printf {| (rule - (deps tests/.ocamlformat %s)%s - (package ocamlformat) + (deps .ocamlformat dune-project)%s (action (with-stdout-to %s (with-stderr-to %s.stderr @@ -126,42 +114,19 @@ let emit_test test_name setup = (rule (alias runtest)%s - (package ocamlformat) (action (diff %s %s.stdout))) (rule (alias runtest)%s - (package ocamlformat) (action (diff %s %s.stderr))) |} - extra_deps enabled_if_line output_fname test_name + enabled_if_line output_fname test_name (cmd setup.should_fail (["%{bin:ocamlformat}"] @ opts @ [dep base_test_name]) ) - enabled_if_line ref_name test_name enabled_if_line err_name test_name ; - if setup.has_ocp then - let ocp_cmd = - "%{bin:ocp-indent}" :: (setup.ocp_opts @ [dep output_fname]) - in - let ocp_out_file = test_name ^ ".ocp.output" in - Printf.printf - {| -(rule - (deps tests/.ocp-indent %s)%s - (package ocamlformat) - (action - (with-outputs-to %s - %s))) - -(rule - (alias runtest)%s - (package ocamlformat) - (action (diff tests/%s.ocp %s))) -|} - extra_deps enabled_if_line ocp_out_file - (cmd setup.should_fail ocp_cmd) - enabled_if_line test_name ocp_out_file + enabled_if_line (ref_file ".ref") test_name enabled_if_line + (ref_file ".err") test_name let () = let map = ref StringMap.empty in - Sys.readdir "./tests" |> Array.iter (register_file map) ; + Sys.readdir input_dir |> Array.iter (register_file map) ; StringMap.iter emit_test !map diff --git a/test/passing/refs.default/.ocamlformat b/test/passing/refs.default/.ocamlformat new file mode 100644 index 0000000000..afed6176ed --- /dev/null +++ b/test/passing/refs.default/.ocamlformat @@ -0,0 +1 @@ +profile=default diff --git a/test/passing/refs.default/align_infix.ml.ref b/test/passing/refs.default/align_infix.ml.ref new file mode 100644 index 0000000000..c468f7785a --- /dev/null +++ b/test/passing/refs.default/align_infix.ml.ref @@ -0,0 +1,5 @@ +let sum_of_squares num = + num + 1 + |> List.range 0 + |> List.map ~f:square + |> List.fold_left ~init:0 ~f:( + ) diff --git a/test/passing/refs.default/alignment.ml.ref b/test/passing/refs.default/alignment.ml.ref new file mode 100644 index 0000000000..fa129fe7ad --- /dev/null +++ b/test/passing/refs.default/alignment.ml.ref @@ -0,0 +1,19 @@ +let file_contents = [] @ [ foo ] @ [ bar ] + +let _ = + match s.src with + | None -> [ zz ] + 2 + | Some s -> + [ + Variable (s_src, OpamFormat.make_string (OpamFilename.to_string s)); yy; + ]; + foo + | Some s -> + { + fww = (s_src, OpamFormat.make_string (OpamFilename.to_string s)); + gdd = yy; + } + +let _ = [ x; y ] @ z +let _ = [ x; y ] @ z +let _ = [ x; y ] @ z diff --git a/test/passing/refs.default/apply.ml.ref b/test/passing/refs.default/apply.ml.ref new file mode 100644 index 0000000000..cd499e5664 --- /dev/null +++ b/test/passing/refs.default/apply.ml.ref @@ -0,0 +1,81 @@ +let _ = List.map ~f:(( + ) (M.f x)) +let id x = x +let plus a ?(b = 0) c = a + b + c;; + +id (plus 1) ~b:1;; + +(* The version above does not type-check, while the version below does + type-check, and should not be formatted to the above. See + https://caml.inria.fr/mantis/view.php?id=7832 for explanation on the + type-checking (and dynamic semantics) distinction. *) + +(id (plus 1)) ~b:1 + +let ( !!! ) a ~b = a + b +let _ = ( !!! ) a b +let _ = ( !!! ) ~b +let _ = !!!!a b d +let _ = ( + ) a b c d + +let cartesian_product l1 l2 = + List.concat (l1 |> List.map (fun v1 -> l2 |> List.map (fun v2 -> (v1, v2)))) + +let cartesian_product' long_list_one long_list_two = + List.concat + (long_list_one + |> List.map (fun v1 -> long_list_two |> List.map (fun v2 -> (v1, v2)))) + +let whatever a_function_name long_list_one some_other_thing = + List.map + (fun long_list_one_elt -> + do_something_with_a_function_and_some_things a_function_name + long_list_one_elt some_other_thing) + long_list_one + +let whatever_labelled a_function_name long_list_one some_other_thing = + ListLabels.map long_list_one ~f:(fun long_list_one_elt -> + do_something_with_a_function_and_some_things a_function_name + long_list_one_elt some_other_thing) + +[@@@ocamlformat "indicate-multiline-delimiters=closing-on-separate-line"] + +let cartesian_product' long_list_one long_list_two = + List.concat + (long_list_one + |> List.map (fun v1 -> long_list_two |> List.map (fun v2 -> (v1, v2))) + ) + +let whatever a_function_name long_list_one some_other_thing = + List.map + (fun long_list_one_elt -> + do_something_with_a_function_and_some_things a_function_name + long_list_one_elt some_other_thing + ) + long_list_one + +let whatever_labelled a_function_name long_list_one some_other_thing = + ListLabels.map long_list_one ~f:(fun long_list_one_elt -> + do_something_with_a_function_and_some_things a_function_name + long_list_one_elt some_other_thing + ) +;; + +(a - b) ();; +((a - b) [@foo]) () + +let _ = M.(loooooooooooooooooooooong + loooooooooooooooooong) + +let _ = + M.( + loooooooooooooooooooooong + loooooooooooooooooong + + llllllllllloooooooooooooooooonnnnnnnnnnnnnggggggggggg + ) + +let _ = + i'm_a_function loooooooooooong + (loooooooooooong looooooooooooooong loooooooooooooong + [ loooooooooong; loooooooooooong; loooooooooooooooooooooong ] + ) + +let f (x :: y) = x +let f (* xx *) ((* aa *) x (* bb *) :: (* cc *) y (* dd *)) (* yy *) = x diff --git a/test/passing/refs.default/apply_functor.ml.ref b/test/passing/refs.default/apply_functor.ml.ref new file mode 100644 index 0000000000..71ee471013 --- /dev/null +++ b/test/passing/refs.default/apply_functor.ml.ref @@ -0,0 +1,8 @@ +module _ = F (functor (X : T) -> X) + +module _ = + F + (functor + (X____________________________ : T) + -> + X____________________________) diff --git a/test/passing/refs.default/args_grouped.ml.ref b/test/passing/refs.default/args_grouped.ml.ref new file mode 100644 index 0000000000..d8bf4409d3 --- /dev/null +++ b/test/passing/refs.default/args_grouped.ml.ref @@ -0,0 +1,90 @@ +let nullsafe_optimistic_third_party_params_in_non_strict = + CLOpt.mk_bool + ~long:"nullsafe-optimistic-third-party-params-in-non-strict" + (* Turned on for compatibility reasons. Historically this is because + there was no actionable way to change third party annotations. Now + that we have such a support, this behavior should be reconsidered, + provided our tooling and error reporting is friendly enough to be + smoothly used by developers. *) + ~default:true + "Nullsafe: in this mode we treat non annotated third party method params as if they were \ + annotated as nullable." + +let test_file_renamings_from_json = + let create_test test_input expected_output _ = + let test_output input = + DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.from_json input + in + foo + in + fooooooooooooooo + +let eval location exp0 astate = + let rec eval exp astate = + match (exp : Exp.t) with + | Var id -> Ok (eval_var (* error in case of missing history? *) [] (Var.of_id id) astate) + | Lvar pvar -> + Ok (eval_var [ ValueHistory.VariableAccessed (pvar, location) ] (Var.of_pvar pvar) astate) + | Lfield (exp', field, _) -> goooooooo + in + fooooooooooooooooooooo + +let declare_locals_and_ret tenv pdesc (prop_ : Prop.normal Prop.t) = + let foooooooooooooo = + BiabductionConfig.run_in_re_execution_mode + (* no footprint vars for locals *) + sigma_locals_and_ret () + in + fooooooooooooooooooooooooooo + +let bottom_up fooooooooooo = + let empty = Int.equal 0 !scheduled && Queue.is_empty pending in + if empty then ( + remaining := 0; + L.progress "Finished call graph scheduling, %d procs remaining (in, or reaching, cycles).@." + (CallGraph.n_procs syntactic_call_graph); + if Config.debug_level_analysis > 0 then CallGraph.to_dotty syntactic_call_graph "cycles.dot"; + foooooooooooooooooo) + else fooooooooooooooooo + +let test_file_renamings_from_json = + let fooooooooooooo = + match expected_output with + | Return exp -> + assert_equal ~pp_diff + ~cmp:DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.equal exp + (test_output test_input) + | Raise exc -> assert_raises exc (fun () -> test_output test_input) + in + foooooooooooooooo + +let gen_with_record_deps ~expand t resolved_forms ~dep_kind = + let foooooooooooooooooooooo = + expand + (* we keep the dir constant here to replicate the old behavior of: + (chdir foo %{exe:bar}). This should lookup ./bar rather than + ./foo/bar *) + resolved_forms ~dir:t.dir ~dep_kind ~expand_var:t.expand_var + in + { t with expand_var } + +let f = + very_long_function_name + ~very_long_variable_name:(very_long expression) + (* this is a + multiple-line-spanning + comment *) + ~y + +let eradicate_meta_class_is_nullsafe = + register ~id:"ERADICATE_META_CLASS_IS_NULLSAFE" + ~hum:"Class is marked @Nullsafe and has 0 issues" + (* Should be enabled for special integrations *) + ~enabled:false Info Eradicate (* TODO *) + ~user_documentation:"" + +let eradicate_meta_class_is_nullsafe = + register ~id:"ERADICATE_META_CLASS_IS_NULLSAFE" (* Should be enabled for special integrations *) + ~hum:"Class is marked @Nullsafe and has 0 issues" + (* Should be enabled for special integrations *) + ~enabled:false Info diff --git a/test/passing/refs.default/array.ml.ref b/test/passing/refs.default/array.ml.ref new file mode 100644 index 0000000000..eaa73cdd14 --- /dev/null +++ b/test/passing/refs.default/array.ml.ref @@ -0,0 +1,43 @@ +[| + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; +|] + +let f = function + | [| + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + 1222222; + |] -> + () diff --git a/test/passing/refs.default/assignment_operator-op_begin_line.ml.err b/test/passing/refs.default/assignment_operator-op_begin_line.ml.err new file mode 100644 index 0000000000..d128155631 --- /dev/null +++ b/test/passing/refs.default/assignment_operator-op_begin_line.ml.err @@ -0,0 +1 @@ +Warning: assignment_operator-op_begin_line.ml:58 exceeds the margin diff --git a/test/passing/refs.default/assignment_operator-op_begin_line.ml.ref b/test/passing/refs.default/assignment_operator-op_begin_line.ml.ref new file mode 100644 index 0000000000..d960fe3d12 --- /dev/null +++ b/test/passing/refs.default/assignment_operator-op_begin_line.ml.ref @@ -0,0 +1,60 @@ +let foo = + entry.logdata.value_end + := entry.logdata.value_end - !remove_size + testtesttest; + entry.logdata.value_end + := (entry.logdata.value_end - !remove_size + testtesttest) [@foo]; + (* foooooooooo *) + entry.logdata.value_end + := (entry.logdata.value_end - !remove_size + testtesttest) [@foo] + (* foooooooooooo *); + entry.logdata.value_end + := entry.logdata.value_end - !remove_size + testtesttest + (* fooooooooooooooooooooooooo *); + value_end + := entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest; + value_end + := (entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest) + [@foo]; + value_end + := (entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest) + [@foo] + (* fooooooooooooo *); + (* foooooooooooooooooooo *) + value_end + := entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest + (* foooooooo *); + foo + +let _ = + r (* _________________________________________________________________ *) := 1 + +let _ = + r + (* _________________________________________________________________ *) + (* _________________________________________________________________ *) := 1 + +let _ = + r := (* _________________________________________________________________ *) 1 + +let _ = + r + := (* _________________________________________________________________ *) + (* _________________________________________________________________ *) + 1 + +let _ = + r (* _________________________________________________________________ *) + := (* _________________________________________________________________ *) 1 + +let _ = + r + (* _________________________________________________________________ *) + (* _________________________________________________________________ *) + := (* _________________________________________________________________ *) + (* _________________________________________________________________ *) + 1 + +let _ = + aaaaaaa + (* __________________________________________________________________________________ *) + := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb diff --git a/test/passing/refs.default/assignment_operator.ml.err b/test/passing/refs.default/assignment_operator.ml.err new file mode 100644 index 0000000000..95b7f0713f --- /dev/null +++ b/test/passing/refs.default/assignment_operator.ml.err @@ -0,0 +1 @@ +Warning: assignment_operator.ml:60 exceeds the margin diff --git a/test/passing/refs.default/assignment_operator.ml.ref b/test/passing/refs.default/assignment_operator.ml.ref new file mode 100644 index 0000000000..44db04d1b6 --- /dev/null +++ b/test/passing/refs.default/assignment_operator.ml.ref @@ -0,0 +1,62 @@ +let foo = + entry.logdata.value_end := + entry.logdata.value_end - !remove_size + testtesttest; + entry.logdata.value_end := + (entry.logdata.value_end - !remove_size + testtesttest) [@foo]; + (* foooooooooo *) + entry.logdata.value_end := + (entry.logdata.value_end - !remove_size + testtesttest) [@foo] + (* foooooooooooo *); + entry.logdata.value_end := + entry.logdata.value_end - !remove_size + testtesttest + (* fooooooooooooooooooooooooo *); + value_end := + entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest; + value_end := + (entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest) + [@foo]; + value_end := + (entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest) + [@foo] + (* fooooooooooooo *); + (* foooooooooooooooooooo *) + value_end := + entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest + (* foooooooo *); + foo + +let _ = + r (* _________________________________________________________________ *) := 1 + +let _ = + r + (* _________________________________________________________________ *) + (* _________________________________________________________________ *) + := 1 + +let _ = + r := (* _________________________________________________________________ *) 1 + +let _ = + r := + (* _________________________________________________________________ *) + (* _________________________________________________________________ *) + 1 + +let _ = + r (* _________________________________________________________________ *) := + (* _________________________________________________________________ *) 1 + +let _ = + r + (* _________________________________________________________________ *) + (* _________________________________________________________________ *) + := + (* _________________________________________________________________ *) + (* _________________________________________________________________ *) + 1 + +let _ = + aaaaaaa + (* __________________________________________________________________________________ *) + := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb diff --git a/test/passing/refs.default/attribute_and_expression.ml.ref b/test/passing/refs.default/attribute_and_expression.ml.ref new file mode 100644 index 0000000000..274ec92477 --- /dev/null +++ b/test/passing/refs.default/attribute_and_expression.ml.ref @@ -0,0 +1,7 @@ +let _ = f (2 [@test 2]) +let tail1 = [ 1; 2 ] [@hello] +let tail2 = 0 :: ([ 1; 2 ] [@hello]) +let tail3 = 0 :: ([] [@hello]) +let _ = ("%d" : _ format) [@p] +let _ = (`B `N : p2) [@p] +let _ = (`So (`Se (`So `O)) : podd) [@p] diff --git a/test/passing/refs.default/attributes.ml.err b/test/passing/refs.default/attributes.ml.err new file mode 100644 index 0000000000..9e2e908c18 --- /dev/null +++ b/test/passing/refs.default/attributes.ml.err @@ -0,0 +1,3 @@ +Warning: attributes.ml:12 exceeds the margin +Warning: attributes.ml:299 exceeds the margin +Warning: attributes.ml:303 exceeds the margin diff --git a/test/passing/refs.default/attributes.ml.ref b/test/passing/refs.default/attributes.ml.ref new file mode 100644 index 0000000000..ac4203aec6 --- /dev/null +++ b/test/passing/refs.default/attributes.ml.ref @@ -0,0 +1,411 @@ +[%foo type[@foo] t = < .. > ] + +let _ = (function[@warning "-4"] None -> true | _ -> false) None +let f (x [@warning ""]) = () +let v = (fun [@inline] x -> x) 1 + +external f : (float[@unboxed]) -> int = "blah" [@@noalloc] +val x : ?x:unit (** not dropped *) -> unit + +type t = { + a : int; + b : int; [@default 1] [@drop_if] + c : int; [@default 1] [@drop_if] (** docstring that is long enough to break *) +} + +type t = { + a : int; + b : someloooooooooooooooooooooooooooooong typ; + [@default looooooooooooooooooooooooooooooooooooooooong] + [@drop_if somethingelse] + b : somelong typ; [@default 1] + c : someloooooooooooooooooooooooooooooong typ; + [@default looooooooooooooooooooooooooooooooooooooooong] + [@drop_if somethingelse] + (** docstring that is long enough to break *) +} + +val foo : int +[@@deprecated "it is good the salad"] [@@warning "-32"] [@@warning "-99"] + +val foo : int +[@@deprecated "it is good the salad"] +[@@warning "-32"] +[@@warning "-99"] +[@@some long comment] + +type t = A of int [@attr] | B of (float[@attr]) | C [@attr] +type t = [ `A of int [@attr] | `B of (float[@attr]) | `C [@attr] ] + +let[@inline always] f x = + let[@something] e = 1 in + e + +module type M = S [@test1] + +module type M = sig + module T (T : sig end) : (S with type t = r [@test2]) + module T (S : S [@test]) : S + module T : (S with type t = (r[@test3]) [@test4]) + + module T : + (S + with type t = t + and type u := u + and module R = R + and module S := S + [@test]) + + module T : module type of X [@test5] + module T : (module type of X) [@test6] + module T : [%ext] [@test7] + module T = T [@@test8] + module [@test8] T = T +end + +let f = fun [@inline] [@inline never] x -> x +let g = fun [@inline] [@something_else] [@ocaml.inline] x -> x +let h x = (g [@inlined] [@ocaml.inlined never]) x +let v = (fun [@inline] [@inlined] x -> x) 1 +let[@inline] i = fun [@inline] x -> x;; + +if [@test] true then () else ();; +if [@test] true then () else if [@test] true then () else () + +let _ = ((A [@test]), (() [@test]), ([] [@test]), [||] [@test]) + +type blocklist = { + f1 : int; [@version 1, 1, 0] (** short comment *) + f2 : (int64 * int64) list; + (** loooooooooooooooooooooooooooooong + commmmmmmmmmmmmmmmmmmmmmmmmmmmmmmment *) +} + +type blocklist = + | F1 of int [@version 1, 1, 0] (** short comment *) + | F2 : int -> blocklist [@version 1, 1, 0] (** short comment *) + | F3 of (int64 * int64) list + (** loooooooooooooooooooooooooooooong + commmmmmmmmmmmmmmmmmmmmmmmmmmmmmmment *) + +type u = + | C of int * int + [@doc + [ + "Lorem ipsum dolor sit amet, consectetur adipiscing elit. "; + "Etiam vel mauris fermentum, condimentum quam a, porta nisi"; + ]] +[@@deriving something] +[@@doc [ "Ut at dolor a eros venenatis maximus ut at nisi." ]] + +let ((A, B) [@test]) = () +let ((lazy a) [@test]) = () +let ((exception a) [@test]) = () +let ((B x) [@test]) = () +let ((`B x) [@test]) = () +let (B [@test]) = () +let (`B [@test]) = () +let (B.(A) [@test]) = () +let ('x' .. 'z' [@test]) = () +let (#test [@test]) = () +let ((module X) [@test]) = () +let (a [@test]) = () +let (_ [@test]) = () +let ("" [@test]) = () +let _ = f x ~f:(fun [@test] x -> x) +let _ = f x ~f:(function [@test] x -> x) +let _ = f x ~f:(function [@test] X -> x | X -> x) + +let () = () +and[@warning "-32"] f = () + +external x : a -> b -> (a -> b[@test]) = "" + +let f = fun [@test] x y -> () +let f y = fun [@test] y -> () +let (f [@test]) = fun y -> fun [@test] y -> () + +module type T = sig + class subst : ((ident -> ident)[@attr]) -> (ident -> ident) -> object + inherit mapper + end[@attr] +end + +let _ = fun [@inlined always] x y -> z +let () = assert ((assert false [@imp Show]) 1.0 = "1.") +let () = f (assert false) +let _ = match x with A -> [%expr match y with e -> e] +let _ = match x with A -> [%expr match y with e -> ( match e with x -> x)] + +type t = { a : int } +[@@deriving xxxxxxxxxxxxxxxxxxxxxxxxxxx] +(* comment *) +[@@deriving xxxxxxxxxxxxxxxxxxxxxxxxxxx] + +module type A = sig + module A := A.B [@@attr] +end + +module M = struct + type t + [@@immediate] + (* ______________________________________ *) + [@@deriving variants, sexp_of] +end + +let _ = {<>} [@a] +let _ = f ({<>} [@a]) +let _ = {} [@a] +let _ = f ({} [@a]) +let _ = (x :> t) [@a] +let _ = f ((x :> t) [@a]) +let _ = (module M) [@a] +let _ = f ((module M) [@a]) +let _ = (module M : S) [@a] +let _ = f ((module M : S) [@a]) +let _ = ([] @ []) [@a] + +(* Infix operator should left-align with the inner parens *) +let _ = + f + ((a_____________________________________ + @ b_____________________________________) + [@a]) + +(* Attribute should wrap as a block *) +let _ = + (a_______________________________________________________________________ + @ b________________________________________________________________) + [@a] + +let _ = + (a_________________________________________________________________ + @ b_________________________________________________________________) + [@a] + +let _ = f (([] @ []) [@a]) +let _ = ("" ^ "") [@a] +let _ = f (("" ^ "") [@a]) +let _ = (0 + 0) [@a] +let _ = f ((0 + 0) [@a]) +let _ = (a.x <- 1) [@a] +let _ = f ((a.x <- 1) [@a]) +let _ = (f @@ a) [@attr] +let _ = f ((f @@ a) [@attr]) +let _ = f 1 ([ e; f ] [@a]) +let _ = f 1 ([| e; f |] [@a]) + +let _ = + object + method g = (a <- b) [@a] + method h = f ((a <- b) [@a]) + + method i = + (a <- b) [@a]; + () + end + +let _ = a.(b) [@a] +let _ = f (a.(b) [@a]) +let _ = (a.*?!@{b} <- c) [@a] +let _ = f ((a.*?!@{b} <- c) [@a]);; + +(* Regression tests for https://github.com/ocaml-ppx/ocamlformat/issues/1256 + (dropped parentheses around tuples with attributes). *) + +(0, 0) [@a] + +let _ = ((0, 0) [@a]) +let _ = f ((0, 0) [@a]);; + +(* Ensure that adding an attribute doesn't break left-alignment of tuple + components *) + +( a________________________________________, + b________________________________________ ) +[@a] + +let _ = + f + (( a________________________________________, + b________________________________________ ) + [@a]) + +let _ = + a [@a]; + b + +let _ = + f + (a [@a]; + b) + +let _ = + a; + b [@a] + +let _ = + f + (a; + b [@a]) + +let _ = + (a; + b) + [@a] + +let _ = + f + ((a; + b) + [@a]) + +let _ = + a; + b [@a]; + c + +let _ = + a; + (b1; + b2) + [@a] + +let _ = + a; + (b1; + b2) + [@a]; + c + +(* Ensure that adding an attribute doesn't break left-alignment of sequenced + expressions *) +let _ = + (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb) + [@a] + +[@@@a (**b*)] + +let (Foo ((A | B) [@attr])) = () +let ([ (A | B) [@attr]; b; c ] [@attr]) = () +let ([| a; (A | B) [@attr]; c |] [@attr]) = () +let { b = (A | B) [@attr] } = () +let (`Foo ((`A | `B) [@attr])) = () +let (A | B) [@attr], (A | B) [@attr] = () +let (A | B) [@attr] = () +let (Foo ((A | B) [@attr]) : (t[@attr])) = () +let (M.(A | B) [@attr]) = ();; + +(a_______________________________________________________________________________ +[@attr]) () +;; + +(a_______________________________________, b____________________________________) +[@attr] +;; +{ a____________________________________ = b___________________________________ } +[@attr] + +let _ = + (match[@ocaml.warning "-4"] bar with _ -> ()); + foo + +let _ = + (try[@ocaml.warning "-4"] bar with _ -> ()); + foo + +let pp f ({ cf_interface; cf_is_objc_block; cf_virtual } [@warning "+9"]) = () + +let pp f + ({ cf_assign_last_arg; cf_injected_destructor; cf_interface } + [@warning "+9"]) = + () + +let pp f + ({ + cf_assign_last_arg; + cf_injected_destructor; + cf_interface; + cf_is_objc_block; + } [@warning "+9"]) = + () + +let _ = f ((* comments *) "c" [@attributes]) +let _ = f ((* comments *) 'c' [@attributes]) +let _ = function ("foo" [@attr]) -> ("bar" [@attr2]) +let _ = function ('A' [@attr]) -> ('B' [@attr2]) | ('A' .. 'B' [@attr2]) -> () + +let _ = + match x with + | _ + when f + ~f:(function [@ocaml.warning + (* ....................................... *) + "-4"] _ -> .) -> + y + +let[@a + (* .............................................. + ........................... .......................... + ...................... *) + foo + (* ....................... *) + (* ................................. *) + (* ...................... *)] _ = + match[@ocaml.warning (* ....................................... *) "-4"] + x [@attr (* .......................... .................. *) some_attr] + with + | _ + when f + ~f:(function[@ocaml.warning + (* ....................................... *) "-4"] + | _ -> .) + ~f:(function[@ocaml.warning + (* ....................................... *) + (* ....................................... *) + "foooooooooooooooooooooooooooo \ + fooooooooooooooooooooooooooooooooooooo"] _ -> .) + ~f:(function[@ocaml.warning + (* ....................................... *) + let x = a and y = b in + x + y] _ -> .) -> + y + [@attr + (* ... *) + (* ... *) + attr (* ... *)] + +let raise_length_mismatch name n1 n2 = + invalid_argf "length mismatch in %s: %d <> %d" name n1 n2 () +[@@cold] [@@inline never] [@@local never] [@@specialise never] + +external unsafe_memset : t -> pos:int -> len:int -> char -> unit + = "bigstring_memset_stub" +[@@noalloc] + +let _ = f ((1 : int) [@a]) +let _ = f ((1 : int) [@a]) ((1 : int) [@a]) +let _ = f ((((1 : int) [@a]) : (int[@b])) [@a]) ((1 : int) [@a]) + +include [@foo] M [@boo] + +let () = + let () = + S.ntyp Cbor_type.Reserved + @@ S.tok + begin [@warning "-4"] + fun ev -> + match ev with Cbor_event.Reserved int -> Some int | _ -> None + end + in + () + +let () = + let () = + S.ntyp Cbor_type.Reserved + @@ (S.tok (fun ev -> + match ev with Cbor_event.Reserved int -> Some int | _ -> None) + [@warning "-4"]) + in + () diff --git a/test/passing/tests/attributes.mli.ref b/test/passing/refs.default/attributes.mli.ref similarity index 100% rename from test/passing/tests/attributes.mli.ref rename to test/passing/refs.default/attributes.mli.ref diff --git a/test/passing/refs.default/binders.ml.ref b/test/passing/refs.default/binders.ml.ref new file mode 100644 index 0000000000..2828a0a30b --- /dev/null +++ b/test/passing/refs.default/binders.ml.ref @@ -0,0 +1,15 @@ +external f : 'a -> 'a = "asdf" + +external g : + 'aaaaaaa 'aaaaaaaaaaaaaaa 'aaaaaaaaaaaaaaaaaaaaaa 'aaaaaaaaaaaaaa 'aaaaaaa + 'fooooo_foooooo. 'a -> 'a -> 'a = "asdf" + +type f = Foo : 'a -> t +type f = Foo : 'a -> 'a +type g = Foo : 'a. 'a -> t + +type g = + | Foo : + 'aaaaaaaaaaa 'bbbbbbbbbbbbbb 'ccccccccccccccc 'fooooo_fooooooo. + 'foo + -> 'b diff --git a/test/passing/refs.default/break_before_in-auto.ml.err b/test/passing/refs.default/break_before_in-auto.ml.err new file mode 100644 index 0000000000..c72b419650 --- /dev/null +++ b/test/passing/refs.default/break_before_in-auto.ml.err @@ -0,0 +1 @@ +Warning: break_before_in-auto.ml:2 exceeds the margin diff --git a/test/passing/tests/break_before_in-auto.ml.ref b/test/passing/refs.default/break_before_in-auto.ml.ref similarity index 84% rename from test/passing/tests/break_before_in-auto.ml.ref rename to test/passing/refs.default/break_before_in-auto.ml.ref index 0f7273ad4b..27c55227d7 100644 --- a/test/passing/tests/break_before_in-auto.ml.ref +++ b/test/passing/refs.default/break_before_in-auto.ml.ref @@ -1,18 +1,16 @@ let flat : unit = let short = 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in - let fooo = - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let fooo = 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in let baaar = 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in let long = - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - in + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in let longer = - 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - + 1 in + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in let longeerer = - 11 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - + 1 in + 11 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in let longest = 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 in @@ -23,11 +21,11 @@ let flat : unit = 1 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 in let violate_margin = - 1 + 11 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 - + 1 in + 1 + 11 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in let violate_margin = - 1 + 111 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 - + 1 in + 1 + 111 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in () let nested : unit = @@ -39,16 +37,16 @@ let nested : unit = let longeerer = let violate_margin = let longest = - 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 - + 11 + 11 + 11 + 11 + 11 + 11 + 11 in - longest + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - + 1 + 1 + 1111 + 1 in + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + + 11 + 11 + 11 + 11 + 11 + 11 in + longest + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + 1 + 1111 + 1 in violate_margin + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in longeerer + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in - longer + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - + 1 + 1 in + longer + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + 1 in long + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in baaar + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 diff --git a/test/passing/refs.default/break_before_in.ml.ref b/test/passing/refs.default/break_before_in.ml.ref new file mode 100644 index 0000000000..2dcbbbf4bf --- /dev/null +++ b/test/passing/refs.default/break_before_in.ml.ref @@ -0,0 +1,66 @@ +let flat : unit = + let short = 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let fooo = + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + let baaar = + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + let long = + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + let longer = + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + let longeerer = + 11 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + let longest = + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + + 11 + 11 + 11 + 11 + in + let violate_margin = + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in + let violate_margin = + 1 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in + let violate_margin = + 1 + 11 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in + let violate_margin = + 1 + 111 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in + () + +let nested : unit = + let short = + let fooo = + let baaar = + let long = + let longer = + let longeerer = + let violate_margin = + let longest = + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + + 11 + 11 + 11 + 11 + 11 + 11 + in + longest + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + 1 + 1111 + 1 + in + violate_margin + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + 1 + 1 + 1 + 1 + 1 + 1 + in + longeerer + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + 1 + 1 + 1 + 1 + in + longer + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + 1 + in + long + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + baaar + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + fooo + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + () diff --git a/test/passing/refs.default/break_cases-align.ml.err b/test/passing/refs.default/break_cases-align.ml.err new file mode 100644 index 0000000000..8eec415173 --- /dev/null +++ b/test/passing/refs.default/break_cases-align.ml.err @@ -0,0 +1 @@ +Warning: break_cases-align.ml:268 exceeds the margin diff --git a/test/passing/refs.default/break_cases-align.ml.ref b/test/passing/refs.default/break_cases-align.ml.ref new file mode 100644 index 0000000000..c45b7633d2 --- /dev/null +++ b/test/passing/refs.default/break_cases-align.ml.ref @@ -0,0 +1,326 @@ +let f x = function + | C + | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) + | A + | K -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () + +let f = + let g = function + | H when x y <> k -> 2 + | T + | P + | U -> + 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + match y with + | O -> 5 + | P when h x -> ( + function + | A -> 6) + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + match y with + | O -> 5 + | P when h x -> ( + function + | A -> 6)); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + (match k with + | foooo -> foooooooo); + fooooooooooooooo fooooooooooooo) +;; + +match x with +| true -> ( + match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy + when fffffffffffffff bbbbbbbbbb yyyyyyyyyy -> + () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> false + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> + match y with + | Some _ -> true + | None -> false + in + () + +let () = + match fooooo with + | x -> x + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) + when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _), + Const (Cfun callee_pname), + (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _, + loc, + _ ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc + +let mod_int c1 c2 is_safe dbg = + match (c1, c2) with + | c1, Cconst_int (0, _) -> + Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x + | -1 -> + () + +let merge_columns l old_table = + let rec aux = function + | [] + | [ None ] -> + ([], []) + in + foooooooooooooooooooooooooo fooooooooooooooooooooo + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> false + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo + +let () = + match v with + | None -> None + | Some x -> + match x with + | None -> None + | Some x -> + match x with + | None -> None + | Some x -> x + +let _ = function + | (exception A) + | B -> + 1 + | C -> 2 + +let _ = function + | A + | (exception B) -> + 1 + | C -> 2 + +let _ = + match x with + | (exception A) + | (exception B) -> + 1 + | C -> 2 + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo) + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> () + end + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () + +let _ = + match x with + | { + y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ); + } -> + () + +let _ = + match x with + | { + y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ); + } -> + () + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo + +let get_nullability = function + | ArrayAccess + | OptimisticFallback (* non-null is the most optimistic type *) + | Undef + (* This is a very special case, assigning non-null is a technical trick *) + -> + Nullability.Nonnull + +let _ = + try () with + | _ -> + match () with + | _ -> () + +let _ = + let _ = + try () with + | _ -> + try () with + | _ -> () + in + () + +let _ = function + | _ -> ( + x >>= function + | `Halt -> return x) + | _ -> () + +let _ = + let _ = function + | _ -> ( + x >>= function + | `Halt -> return x) + | _ -> () + in + () + +class c = + let _ = function + | _ -> ( + x >>= function + | `Halt -> return x) + | _ -> () + in + object end diff --git a/test/passing/refs.default/break_cases-all.ml.err b/test/passing/refs.default/break_cases-all.ml.err new file mode 100644 index 0000000000..2a818e9900 --- /dev/null +++ b/test/passing/refs.default/break_cases-all.ml.err @@ -0,0 +1 @@ +Warning: break_cases-all.ml:268 exceeds the margin diff --git a/test/passing/refs.default/break_cases-all.ml.ref b/test/passing/refs.default/break_cases-all.ml.ref new file mode 100644 index 0000000000..94e26ba56e --- /dev/null +++ b/test/passing/refs.default/break_cases-all.ml.ref @@ -0,0 +1,326 @@ +let f x = function + | C + | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) + | A + | K -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () + +let f = + let g = function + | H when x y <> k -> 2 + | T + | P + | U -> + 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> ( + match y with + | O -> 5 + | P when h x -> ( + function + | A -> 6)) + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> ( + match y with + | O -> 5 + | P when h x -> ( + function + | A -> 6))); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + (match k with + | foooo -> foooooooo); + fooooooooooooooo fooooooooooooo) +;; + +match x with +| true -> ( + match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy + when fffffffffffffff bbbbbbbbbb yyyyyyyyyy -> + () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> false + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( + match y with + | Some _ -> true + | None -> false) + in + () + +let () = + match fooooo with + | x -> x + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) + when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _), + Const (Cfun callee_pname), + (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _, + loc, + _ ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc + +let mod_int c1 c2 is_safe dbg = + match (c1, c2) with + | c1, Cconst_int (0, _) -> + Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x + | -1 -> + () + +let merge_columns l old_table = + let rec aux = function + | [] + | [ None ] -> + ([], []) + in + foooooooooooooooooooooooooo fooooooooooooooooooooo + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> false + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo + +let () = + match v with + | None -> None + | Some x -> ( + match x with + | None -> None + | Some x -> ( + match x with + | None -> None + | Some x -> x)) + +let _ = function + | (exception A) + | B -> + 1 + | C -> 2 + +let _ = function + | A + | (exception B) -> + 1 + | C -> 2 + +let _ = + match x with + | (exception A) + | (exception B) -> + 1 + | C -> 2 + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo) + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> () + end + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () + +let _ = + match x with + | { + y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ); + } -> + () + +let _ = + match x with + | { + y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ); + } -> + () + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo + +let get_nullability = function + | ArrayAccess + | OptimisticFallback (* non-null is the most optimistic type *) + | Undef + (* This is a very special case, assigning non-null is a technical trick *) + -> + Nullability.Nonnull + +let _ = + try () with + | _ -> ( + match () with + | _ -> ()) + +let _ = + let _ = + try () with + | _ -> ( + try () with + | _ -> ()) + in + () + +let _ = function + | _ -> ( + x >>= function + | `Halt -> return x) + | _ -> () + +let _ = + let _ = function + | _ -> ( + x >>= function + | `Halt -> return x) + | _ -> () + in + () + +class c = + let _ = function + | _ -> ( + x >>= function + | `Halt -> return x) + | _ -> () + in + object end diff --git a/test/passing/refs.default/break_cases-closing_on_separate_line.ml.err b/test/passing/refs.default/break_cases-closing_on_separate_line.ml.err new file mode 100644 index 0000000000..26544c9c91 --- /dev/null +++ b/test/passing/refs.default/break_cases-closing_on_separate_line.ml.err @@ -0,0 +1 @@ +Warning: break_cases-closing_on_separate_line.ml:281 exceeds the margin diff --git a/test/passing/refs.default/break_cases-closing_on_separate_line.ml.ref b/test/passing/refs.default/break_cases-closing_on_separate_line.ml.ref new file mode 100644 index 0000000000..3812d5bb2b --- /dev/null +++ b/test/passing/refs.default/break_cases-closing_on_separate_line.ml.ref @@ -0,0 +1,344 @@ +let f x = function + | C + | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) + | A + | K -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () + +let f = + let g = function + | H when x y <> k -> 2 + | T + | P + | U -> + 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> ( + match y with + | O -> 5 + | P when h x -> ( + function + | A -> 6 + ) + ) + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> ( + match y with + | O -> 5 + | P when h x -> ( + function + | A -> 6 + ) + ) + ); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + ( match k with + | foooo -> foooooooo + ); + fooooooooooooooo fooooooooooooo + ) +;; + +match x with +| true -> ( + match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" + ) +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy + when fffffffffffffff bbbbbbbbbb yyyyyyyyyy -> + () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> false + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( + match y with + | Some _ -> true + | None -> false + ) + in + () + +let () = + match fooooo with + | x -> x + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) + when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _), + Const (Cfun callee_pname), + (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _, + loc, + _ + ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc + +let mod_int c1 c2 is_safe dbg = + match (c1, c2) with + | c1, Cconst_int (0, _) -> + Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x + | -1 -> + () + +let merge_columns l old_table = + let rec aux = function + | [] + | [ None ] -> + ([], []) + in + foooooooooooooooooooooooooo fooooooooooooooooooooo + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> false + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo + +let () = + match v with + | None -> None + | Some x -> ( + match x with + | None -> None + | Some x -> ( + match x with + | None -> None + | Some x -> x + ) + ) + +let _ = function + | (exception A) + | B -> + 1 + | C -> 2 + +let _ = function + | A + | (exception B) -> + 1 + | C -> 2 + +let _ = + match x with + | (exception A) + | (exception B) -> + 1 + | C -> 2 + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + ) + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> () + end + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () + +let _ = + match x with + | { + y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ); + } -> + () + +let _ = + match x with + | { + y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ); + } -> + () + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo + +let get_nullability = function + | ArrayAccess + | OptimisticFallback (* non-null is the most optimistic type *) + | Undef + (* This is a very special case, assigning non-null is a technical trick *) + -> + Nullability.Nonnull + +let _ = + try () with + | _ -> ( + match () with + | _ -> () + ) + +let _ = + let _ = + try () with + | _ -> ( + try () with + | _ -> () + ) + in + () + +let _ = function + | _ -> ( + x >>= function + | `Halt -> return x + ) + | _ -> () + +let _ = + let _ = function + | _ -> ( + x >>= function + | `Halt -> return x + ) + | _ -> () + in + () + +class c = + let _ = function + | _ -> ( + x >>= function + | `Halt -> return x + ) + | _ -> () + in + object end diff --git a/test/passing/refs.default/break_cases-closing_on_separate_line_fit_or_vertical.ml.err b/test/passing/refs.default/break_cases-closing_on_separate_line_fit_or_vertical.ml.err new file mode 100644 index 0000000000..c8f6e46a61 --- /dev/null +++ b/test/passing/refs.default/break_cases-closing_on_separate_line_fit_or_vertical.ml.err @@ -0,0 +1 @@ +Warning: break_cases-closing_on_separate_line_fit_or_vertical.ml:242 exceeds the margin diff --git a/test/passing/refs.default/break_cases-closing_on_separate_line_fit_or_vertical.ml.ref b/test/passing/refs.default/break_cases-closing_on_separate_line_fit_or_vertical.ml.ref new file mode 100644 index 0000000000..bb28f934e8 --- /dev/null +++ b/test/passing/refs.default/break_cases-closing_on_separate_line_fit_or_vertical.ml.ref @@ -0,0 +1,300 @@ +let f x = function + | C | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) | A | K + -> 1 + | D -> + let a = "this" in + let b = "breaks" in + () + +let f = + let g = function + | H when x y <> k -> 2 + | T | P | U -> 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z | P | M -> ( + match y with + | O -> 5 + | P when h x -> ( + function + | A -> 6 + ) + ) + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z | P | M -> ( + match y with + | O -> 5 + | P when h x -> ( + function + | A -> 6 + ) + ) + ); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + ( match k with + | foooo -> foooooooo + ); + fooooooooooooooo fooooooooooooo + ) +;; + +match x with +| true -> ( + match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" + ) +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy + when fffffffffffffff bbbbbbbbbb yyyyyyyyyy -> () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> true + | _ -> false + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( + match y with + | Some _ -> true + | None -> false + ) + in + () + +let () = + match fooooo with + | x -> x + +let () = + match foooo with + | x | x | x -> x + | y | foooooooooo | fooooooooo -> y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) + when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _), + Const (Cfun callee_pname), + (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _, + loc, + _ + ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc + +let mod_int c1 c2 is_safe dbg = + match (c1, c2) with + | c1, Cconst_int (0, _) -> + Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x | -1 -> () + +let merge_columns l old_table = + let rec aux = function + | [] | [ None ] -> ([], []) + in + foooooooooooooooooooooooooo fooooooooooooooooooooo + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> true + | _ -> false + +let () = + match foooo with + | x | x | x -> x + | y | foooooooooo | fooooooooo -> y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo + +let () = + match v with + | None -> None + | Some x -> ( + match x with + | None -> None + | Some x -> ( + match x with + | None -> None + | Some x -> x + ) + ) + +let _ = function + | (exception A) | B -> 1 + | C -> 2 + +let _ = function + | A | (exception B) -> 1 + | C -> 2 + +let _ = + match x with + | (exception A) | (exception B) -> 1 + | C -> 2 + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + ) + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> Errors.isset_in_strict p + | _ -> () + end + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> () + +let _ = + match x with + | { + y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ); + } -> () + +let _ = + match x with + | { + y = + ( Z + (* _____________________________________________________________________ *) + | X _ + | Y _ ); + } -> () + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo + +let get_nullability = function + | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) + | Undef + (* This is a very special case, assigning non-null is a technical trick *) + -> Nullability.Nonnull + +let _ = + try () + with _ -> ( + match () with + | _ -> () + ) + +let _ = + let _ = + try () + with _ -> ( try () with _ -> () + ) + in + () + +let _ = function + | _ -> ( + x >>= function + | `Halt -> return x + ) + | _ -> () + +let _ = + let _ = function + | _ -> ( + x >>= function + | `Halt -> return x + ) + | _ -> () + in + () + +class c = + let _ = function + | _ -> ( + x >>= function + | `Halt -> return x + ) + | _ -> () + in + object end diff --git a/test/passing/refs.default/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err b/test/passing/refs.default/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err new file mode 100644 index 0000000000..8d959fa312 --- /dev/null +++ b/test/passing/refs.default/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err @@ -0,0 +1 @@ +Warning: break_cases-closing_on_separate_line_leading_nested_match_parens.ml:281 exceeds the margin diff --git a/test/passing/refs.default/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref b/test/passing/refs.default/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref new file mode 100644 index 0000000000..9a3f8200b9 --- /dev/null +++ b/test/passing/refs.default/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref @@ -0,0 +1,341 @@ +let f x = function + | C + | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) + | A + | K -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () + +let f = + let g = function + | H when x y <> k -> 2 + | T + | P + | U -> + 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + ( match y with + | O -> 5 + | P when h x -> + (function + | A -> 6 + ) + ) + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + ( match y with + | O -> 5 + | P when h x -> + (function + | A -> 6 + ) + ) + ); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + ( match k with + | foooo -> foooooooo + ); + fooooooooooooooo fooooooooooooo + ) +;; + +match x with +| true -> + ( match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" + ) +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy + when fffffffffffffff bbbbbbbbbb yyyyyyyyyy -> + () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> false + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> + ( match y with + | Some _ -> true + | None -> false + ) + in + () + +let () = + match fooooo with + | x -> x + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) + when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _), + Const (Cfun callee_pname), + (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _, + loc, + _ + ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc + +let mod_int c1 c2 is_safe dbg = + match (c1, c2) with + | c1, Cconst_int (0, _) -> + Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x + | -1 -> + () + +let merge_columns l old_table = + let rec aux = function + | [] + | [ None ] -> + ([], []) + in + foooooooooooooooooooooooooo fooooooooooooooooooooo + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> false + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo + +let () = + match v with + | None -> None + | Some x -> + ( match x with + | None -> None + | Some x -> + ( match x with + | None -> None + | Some x -> x + ) + ) + +let _ = function + | (exception A) + | B -> + 1 + | C -> 2 + +let _ = function + | A + | (exception B) -> + 1 + | C -> 2 + +let _ = + match x with + | (exception A) + | (exception B) -> + 1 + | C -> 2 + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + ) + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> () + end + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () + +let _ = + match x with + | { + y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ); + } -> + () + +let _ = + match x with + | { + y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ); + } -> + () + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo + +let get_nullability = function + | ArrayAccess + | OptimisticFallback (* non-null is the most optimistic type *) + | Undef + (* This is a very special case, assigning non-null is a technical trick *) + -> + Nullability.Nonnull + +let _ = + try () with + | _ -> + ( match () with + | _ -> () + ) + +let _ = + let _ = + try () with + | _ -> + ( try () with + | _ -> () + ) + in + () + +let _ = function + | _ -> + x >>= ( function + | `Halt -> return x ) + | _ -> () + +let _ = + let _ = function + | _ -> + x >>= ( function + | `Halt -> return x ) + | _ -> () + in + () + +class c = + let _ = function + | _ -> + x >>= ( function + | `Halt -> return x ) + | _ -> () + in + object end diff --git a/test/passing/refs.default/break_cases-cosl_lnmp_cmei.ml.err b/test/passing/refs.default/break_cases-cosl_lnmp_cmei.ml.err new file mode 100644 index 0000000000..f13eb98c3d --- /dev/null +++ b/test/passing/refs.default/break_cases-cosl_lnmp_cmei.ml.err @@ -0,0 +1 @@ +Warning: break_cases-cosl_lnmp_cmei.ml:281 exceeds the margin diff --git a/test/passing/refs.default/break_cases-cosl_lnmp_cmei.ml.ref b/test/passing/refs.default/break_cases-cosl_lnmp_cmei.ml.ref new file mode 100644 index 0000000000..9a3f8200b9 --- /dev/null +++ b/test/passing/refs.default/break_cases-cosl_lnmp_cmei.ml.ref @@ -0,0 +1,341 @@ +let f x = function + | C + | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) + | A + | K -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () + +let f = + let g = function + | H when x y <> k -> 2 + | T + | P + | U -> + 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + ( match y with + | O -> 5 + | P when h x -> + (function + | A -> 6 + ) + ) + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + ( match y with + | O -> 5 + | P when h x -> + (function + | A -> 6 + ) + ) + ); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + ( match k with + | foooo -> foooooooo + ); + fooooooooooooooo fooooooooooooo + ) +;; + +match x with +| true -> + ( match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" + ) +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy + when fffffffffffffff bbbbbbbbbb yyyyyyyyyy -> + () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> false + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> + ( match y with + | Some _ -> true + | None -> false + ) + in + () + +let () = + match fooooo with + | x -> x + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) + when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _), + Const (Cfun callee_pname), + (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _, + loc, + _ + ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc + +let mod_int c1 c2 is_safe dbg = + match (c1, c2) with + | c1, Cconst_int (0, _) -> + Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x + | -1 -> + () + +let merge_columns l old_table = + let rec aux = function + | [] + | [ None ] -> + ([], []) + in + foooooooooooooooooooooooooo fooooooooooooooooooooo + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> false + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo + +let () = + match v with + | None -> None + | Some x -> + ( match x with + | None -> None + | Some x -> + ( match x with + | None -> None + | Some x -> x + ) + ) + +let _ = function + | (exception A) + | B -> + 1 + | C -> 2 + +let _ = function + | A + | (exception B) -> + 1 + | C -> 2 + +let _ = + match x with + | (exception A) + | (exception B) -> + 1 + | C -> 2 + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + ) + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> () + end + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () + +let _ = + match x with + | { + y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ); + } -> + () + +let _ = + match x with + | { + y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ); + } -> + () + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo + +let get_nullability = function + | ArrayAccess + | OptimisticFallback (* non-null is the most optimistic type *) + | Undef + (* This is a very special case, assigning non-null is a technical trick *) + -> + Nullability.Nonnull + +let _ = + try () with + | _ -> + ( match () with + | _ -> () + ) + +let _ = + let _ = + try () with + | _ -> + ( try () with + | _ -> () + ) + in + () + +let _ = function + | _ -> + x >>= ( function + | `Halt -> return x ) + | _ -> () + +let _ = + let _ = function + | _ -> + x >>= ( function + | `Halt -> return x ) + | _ -> () + in + () + +class c = + let _ = function + | _ -> + x >>= ( function + | `Halt -> return x ) + | _ -> () + in + object end diff --git a/test/passing/refs.default/break_cases-fit_or_vertical.ml.err b/test/passing/refs.default/break_cases-fit_or_vertical.ml.err new file mode 100644 index 0000000000..5e97ed2e1e --- /dev/null +++ b/test/passing/refs.default/break_cases-fit_or_vertical.ml.err @@ -0,0 +1 @@ +Warning: break_cases-fit_or_vertical.ml:229 exceeds the margin diff --git a/test/passing/refs.default/break_cases-fit_or_vertical.ml.ref b/test/passing/refs.default/break_cases-fit_or_vertical.ml.ref new file mode 100644 index 0000000000..71af7cfdeb --- /dev/null +++ b/test/passing/refs.default/break_cases-fit_or_vertical.ml.ref @@ -0,0 +1,279 @@ +let f x = function + | C | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) | A | K + -> 1 + | D -> + let a = "this" in + let b = "breaks" in + () + +let f = + let g = function + | H when x y <> k -> 2 + | T | P | U -> 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z | P | M -> ( + match y with + | O -> 5 + | P when h x -> ( + function + | A -> 6)) + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z | P | M -> ( + match y with + | O -> 5 + | P when h x -> ( + function + | A -> 6))); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + (match k with + | foooo -> foooooooo); + fooooooooooooooo fooooooooooooo) +;; + +match x with +| true -> ( + match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy + when fffffffffffffff bbbbbbbbbb yyyyyyyyyy -> () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> true + | _ -> false + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( + match y with + | Some _ -> true + | None -> false) + in + () + +let () = + match fooooo with + | x -> x + +let () = + match foooo with + | x | x | x -> x + | y | foooooooooo | fooooooooo -> y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) + when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _), + Const (Cfun callee_pname), + (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _, + loc, + _ ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc + +let mod_int c1 c2 is_safe dbg = + match (c1, c2) with + | c1, Cconst_int (0, _) -> + Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x | -1 -> () + +let merge_columns l old_table = + let rec aux = function + | [] | [ None ] -> ([], []) + in + foooooooooooooooooooooooooo fooooooooooooooooooooo + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> true + | _ -> false + +let () = + match foooo with + | x | x | x -> x + | y | foooooooooo | fooooooooo -> y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo + +let () = + match v with + | None -> None + | Some x -> ( + match x with + | None -> None + | Some x -> ( + match x with + | None -> None + | Some x -> x)) + +let _ = function + | (exception A) | B -> 1 + | C -> 2 + +let _ = function + | A | (exception B) -> 1 + | C -> 2 + +let _ = + match x with + | (exception A) | (exception B) -> 1 + | C -> 2 + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo) + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> Errors.isset_in_strict p + | _ -> () + end + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> () + +let _ = + match x with + | { + y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ); + } -> () + +let _ = + match x with + | { + y = + ( Z + (* _____________________________________________________________________ *) + | X _ + | Y _ ); + } -> () + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo + +let get_nullability = function + | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) + | Undef + (* This is a very special case, assigning non-null is a technical trick *) + -> Nullability.Nonnull + +let _ = + try () + with _ -> ( + match () with + | _ -> ()) + +let _ = + let _ = try () with _ -> ( try () with _ -> ()) in + () + +let _ = function + | _ -> ( + x >>= function + | `Halt -> return x) + | _ -> () + +let _ = + let _ = function + | _ -> ( + x >>= function + | `Halt -> return x) + | _ -> () + in + () + +class c = + let _ = function + | _ -> ( + x >>= function + | `Halt -> return x) + | _ -> () + in + object end diff --git a/test/passing/refs.default/break_cases-nested.ml.err b/test/passing/refs.default/break_cases-nested.ml.err new file mode 100644 index 0000000000..be43429a10 --- /dev/null +++ b/test/passing/refs.default/break_cases-nested.ml.err @@ -0,0 +1 @@ +Warning: break_cases-nested.ml:232 exceeds the margin diff --git a/test/passing/refs.default/break_cases-nested.ml.ref b/test/passing/refs.default/break_cases-nested.ml.ref new file mode 100644 index 0000000000..980fba5474 --- /dev/null +++ b/test/passing/refs.default/break_cases-nested.ml.ref @@ -0,0 +1,267 @@ +let f x = function + | C | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) | A | K + -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () + +let f = + let g = function H when x y <> k -> 2 | T | P | U -> 3 in + fun x g t h y u -> + match x with + | E -> + 4 + | Z | P | M -> ( + match y with O -> 5 | P when h x -> ( function A -> 6)) + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> + 4 + | Z | P | M -> ( + match y with O -> 5 | P when h x -> ( function A -> 6))); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + (match k with foooo -> foooooooo); + fooooooooooooooo fooooooooooooo) +;; + +match x with +| true -> ( + match y with + | true -> + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> + "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") +| false -> + "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy + when fffffffffffffff bbbbbbbbbb yyyyyyyyyy -> + () +| _ -> + () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> + false + +let _ = + let f x y = + match x with + | None -> + false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( + match y with Some _ -> true | None -> false) + in + () + +let () = match fooooo with x -> x + +let () = + match foooo with + | x | x | x -> + x + | y | foooooooooo | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) + when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _), + Const (Cfun callee_pname), + (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _, + loc, + _ ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc + +let mod_int c1 c2 is_safe dbg = + match (c1, c2) with + | c1, Cconst_int (0, _) -> + Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> + Csequence (c1, Cconst_int (0, dbg)) + | x | -1 -> + () + +let merge_columns l old_table = + let rec aux = function [] | [ None ] -> ([], []) in + foooooooooooooooooooooooooo fooooooooooooooooooooo + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> + false + +let () = + match foooo with + | x | x | x -> + x + | y | foooooooooo | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> + fooooooooooooooooo + +let () = + match v with + | None -> + None + | Some x -> ( + match x with + | None -> + None + | Some x -> ( + match x with None -> None | Some x -> x)) + +let _ = function (exception A) | B -> 1 | C -> 2 +let _ = function A | (exception B) -> 1 | C -> 2 +let _ = match x with (exception A) | (exception B) -> 1 | C -> 2 + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> + fooooooooooo + | foooooooooo -> + fooooooooooo + | foooooooooo -> + fooooooooooo) + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> + () + end + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () + +let _ = + match x with + | { + y = + (* _____________________________________________________________________ *) + ( X _ + | Y _ ); + } -> + () + +let _ = + match x with + | { + y = + ( Z + (* _____________________________________________________________________ *) + | X _ + | Y _ ); + } -> + () + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo + +let get_nullability = function + | ArrayAccess + | OptimisticFallback (* non-null is the most optimistic type *) + | Undef + (* This is a very special case, assigning non-null is a technical trick *) + -> + Nullability.Nonnull + +let _ = try () with _ -> ( match () with _ -> ()) + +let _ = + let _ = try () with _ -> ( try () with _ -> ()) in + () + +let _ = function _ -> ( x >>= function `Halt -> return x) | _ -> () + +let _ = + let _ = function _ -> ( x >>= function `Halt -> return x) | _ -> () in + () + +class c = + let _ = function _ -> ( x >>= function `Halt -> return x) | _ -> () in + object end diff --git a/test/passing/refs.default/break_cases-normal_indent.ml.err b/test/passing/refs.default/break_cases-normal_indent.ml.err new file mode 100644 index 0000000000..243adbf007 --- /dev/null +++ b/test/passing/refs.default/break_cases-normal_indent.ml.err @@ -0,0 +1 @@ +Warning: break_cases-normal_indent.ml:268 exceeds the margin diff --git a/test/passing/refs.default/break_cases-normal_indent.ml.ref b/test/passing/refs.default/break_cases-normal_indent.ml.ref new file mode 100644 index 0000000000..94e26ba56e --- /dev/null +++ b/test/passing/refs.default/break_cases-normal_indent.ml.ref @@ -0,0 +1,326 @@ +let f x = function + | C + | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) + | A + | K -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () + +let f = + let g = function + | H when x y <> k -> 2 + | T + | P + | U -> + 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> ( + match y with + | O -> 5 + | P when h x -> ( + function + | A -> 6)) + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> ( + match y with + | O -> 5 + | P when h x -> ( + function + | A -> 6))); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + (match k with + | foooo -> foooooooo); + fooooooooooooooo fooooooooooooo) +;; + +match x with +| true -> ( + match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy + when fffffffffffffff bbbbbbbbbb yyyyyyyyyy -> + () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> false + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( + match y with + | Some _ -> true + | None -> false) + in + () + +let () = + match fooooo with + | x -> x + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) + when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _), + Const (Cfun callee_pname), + (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _, + loc, + _ ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc + +let mod_int c1 c2 is_safe dbg = + match (c1, c2) with + | c1, Cconst_int (0, _) -> + Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x + | -1 -> + () + +let merge_columns l old_table = + let rec aux = function + | [] + | [ None ] -> + ([], []) + in + foooooooooooooooooooooooooo fooooooooooooooooooooo + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> false + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo + +let () = + match v with + | None -> None + | Some x -> ( + match x with + | None -> None + | Some x -> ( + match x with + | None -> None + | Some x -> x)) + +let _ = function + | (exception A) + | B -> + 1 + | C -> 2 + +let _ = function + | A + | (exception B) -> + 1 + | C -> 2 + +let _ = + match x with + | (exception A) + | (exception B) -> + 1 + | C -> 2 + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo) + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> () + end + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () + +let _ = + match x with + | { + y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ); + } -> + () + +let _ = + match x with + | { + y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ); + } -> + () + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo + +let get_nullability = function + | ArrayAccess + | OptimisticFallback (* non-null is the most optimistic type *) + | Undef + (* This is a very special case, assigning non-null is a technical trick *) + -> + Nullability.Nonnull + +let _ = + try () with + | _ -> ( + match () with + | _ -> ()) + +let _ = + let _ = + try () with + | _ -> ( + try () with + | _ -> ()) + in + () + +let _ = function + | _ -> ( + x >>= function + | `Halt -> return x) + | _ -> () + +let _ = + let _ = function + | _ -> ( + x >>= function + | `Halt -> return x) + | _ -> () + in + () + +class c = + let _ = function + | _ -> ( + x >>= function + | `Halt -> return x) + | _ -> () + in + object end diff --git a/test/passing/refs.default/break_cases-toplevel.ml.err b/test/passing/refs.default/break_cases-toplevel.ml.err new file mode 100644 index 0000000000..57a2d51260 --- /dev/null +++ b/test/passing/refs.default/break_cases-toplevel.ml.err @@ -0,0 +1 @@ +Warning: break_cases-toplevel.ml:234 exceeds the margin diff --git a/test/passing/refs.default/break_cases-toplevel.ml.ref b/test/passing/refs.default/break_cases-toplevel.ml.ref new file mode 100644 index 0000000000..843bbc1011 --- /dev/null +++ b/test/passing/refs.default/break_cases-toplevel.ml.ref @@ -0,0 +1,285 @@ +let f x = function + | C | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) | A | K + -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () + +let f = + let g = function + | H when x y <> k -> 2 + | T | P | U -> 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z | P | M -> ( + match y with + | O -> 5 + | P when h x -> ( + function + | A -> 6)) + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z | P | M -> ( + match y with + | O -> 5 + | P when h x -> ( + function + | A -> 6))); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + (match k with + | foooo -> foooooooo); + fooooooooooooooo fooooooooooooo) +;; + +match x with +| true -> ( + match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy + when fffffffffffffff bbbbbbbbbb yyyyyyyyyy -> + () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> false + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( + match y with + | Some _ -> true + | None -> false) + in + () + +let () = + match fooooo with + | x -> x + +let () = + match foooo with + | x | x | x -> x + | y | foooooooooo | fooooooooo -> y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) + when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _), + Const (Cfun callee_pname), + (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _, + loc, + _ ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc + +let mod_int c1 c2 is_safe dbg = + match (c1, c2) with + | c1, Cconst_int (0, _) -> + Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x | -1 -> () + +let merge_columns l old_table = + let rec aux = function + | [] | [ None ] -> ([], []) + in + foooooooooooooooooooooooooo fooooooooooooooooooooo + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> false + +let () = + match foooo with + | x | x | x -> x + | y | foooooooooo | fooooooooo -> y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa | Bbbbbbbbbbbbbbbbb | Ccccccccccccccccc + | Ddddddddddddddddd | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo + +let () = + match v with + | None -> None + | Some x -> ( + match x with + | None -> None + | Some x -> ( + match x with + | None -> None + | Some x -> x)) + +let _ = function + | (exception A) | B -> 1 + | C -> 2 + +let _ = function + | A | (exception B) -> 1 + | C -> 2 + +let _ = + match x with + | (exception A) | (exception B) -> 1 + | C -> 2 + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo) + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> () + end + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () + +let _ = + match x with + | { + y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ); + } -> + () + +let _ = + match x with + | { + y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ); + } -> + () + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo + +let get_nullability = function + | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) + | Undef + (* This is a very special case, assigning non-null is a technical trick *) + -> + Nullability.Nonnull + +let _ = + try () + with _ -> ( + match () with + | _ -> ()) + +let _ = + let _ = try () with _ -> ( try () with _ -> ()) in + () + +let _ = function + | _ -> ( + x >>= function + | `Halt -> return x) + | _ -> () + +let _ = + let _ = function + | _ -> ( + x >>= function + | `Halt -> return x) + | _ -> () + in + () + +class c = + let _ = function + | _ -> ( + x >>= function + | `Halt -> return x) + | _ -> () + in + object end diff --git a/test/passing/refs.default/break_cases-vertical.ml.err b/test/passing/refs.default/break_cases-vertical.ml.err new file mode 100644 index 0000000000..f64cb2291e --- /dev/null +++ b/test/passing/refs.default/break_cases-vertical.ml.err @@ -0,0 +1 @@ +Warning: break_cases-vertical.ml:300 exceeds the margin diff --git a/test/passing/refs.default/break_cases-vertical.ml.ref b/test/passing/refs.default/break_cases-vertical.ml.ref new file mode 100644 index 0000000000..8967efa340 --- /dev/null +++ b/test/passing/refs.default/break_cases-vertical.ml.ref @@ -0,0 +1,366 @@ +let f x = function + | C + | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) + | A + | K -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () + +let f = + let g = function + | H when x y <> k -> + 2 + | T + | P + | U -> + 3 + in + fun x g t h y u -> + match x with + | E -> + 4 + | Z + | P + | M -> ( + match y with + | O -> + 5 + | P when h x -> ( + function + | A -> + 6)) + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> + 4 + | Z + | P + | M -> ( + match y with + | O -> + 5 + | P when h x -> ( + function + | A -> + 6))); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + (match k with + | foooo -> + foooooooo); + fooooooooooooooo fooooooooooooo) +;; + +match x with +| true -> ( + match y with + | true -> + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> + "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") +| false -> + "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy + when fffffffffffffff bbbbbbbbbb yyyyyyyyyy -> + () +| _ -> + () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> + false + +let _ = + let f x y = + match x with + | None -> + false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( + match y with + | Some _ -> + true + | None -> + false) + in + () + +let () = + match fooooo with + | x -> + x + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) + when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _), + Const (Cfun callee_pname), + (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _, + loc, + _ ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc + +let mod_int c1 c2 is_safe dbg = + match (c1, c2) with + | c1, Cconst_int (0, _) -> + Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> + Csequence (c1, Cconst_int (0, dbg)) + | x + | -1 -> + () + +let merge_columns l old_table = + let rec aux = function + | [] + | [ None ] -> + ([], []) + in + foooooooooooooooooooooooooo fooooooooooooooooooooo + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> + false + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> + fooooooooooooooooo + +let () = + match v with + | None -> + None + | Some x -> ( + match x with + | None -> + None + | Some x -> ( + match x with + | None -> + None + | Some x -> + x)) + +let _ = function + | (exception A) + | B -> + 1 + | C -> + 2 + +let _ = function + | A + | (exception B) -> + 1 + | C -> + 2 + +let _ = + match x with + | (exception A) + | (exception B) -> + 1 + | C -> + 2 + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> + fooooooooooo + | foooooooooo -> + fooooooooooo + | foooooooooo -> + fooooooooooo) + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> + () + end + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () + +let _ = + match x with + | { + y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ); + } -> + () + +let _ = + match x with + | { + y = + ( Z + (* _____________________________________________________________________ *) + | X _ + | Y _ ); + } -> + () + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo + +let get_nullability = function + | ArrayAccess + | OptimisticFallback (* non-null is the most optimistic type *) + | Undef + (* This is a very special case, assigning non-null is a technical trick *) + -> + Nullability.Nonnull + +let _ = + try () with + | _ -> ( + match () with + | _ -> + ()) + +let _ = + let _ = + try () with + | _ -> ( + try () with + | _ -> + ()) + in + () + +let _ = function + | _ -> ( + x >>= function + | `Halt -> + return x) + | _ -> + () + +let _ = + let _ = function + | _ -> ( + x >>= function + | `Halt -> + return x) + | _ -> + () + in + () + +class c = + let _ = function + | _ -> ( + x >>= function + | `Halt -> + return x) + | _ -> + () + in + object end diff --git a/test/passing/refs.default/break_cases.ml.err b/test/passing/refs.default/break_cases.ml.err new file mode 100644 index 0000000000..3cac7951a8 --- /dev/null +++ b/test/passing/refs.default/break_cases.ml.err @@ -0,0 +1 @@ +Warning: break_cases.ml:203 exceeds the margin diff --git a/test/passing/refs.default/break_cases.ml.ref b/test/passing/refs.default/break_cases.ml.ref new file mode 100644 index 0000000000..8f1341b657 --- /dev/null +++ b/test/passing/refs.default/break_cases.ml.ref @@ -0,0 +1,236 @@ +let f x = function + | C | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) | A | K + -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () + +let f = + let g = function H when x y <> k -> 2 | T | P | U -> 3 in + fun x g t h y u -> + match x with + | E -> 4 + | Z | P | M -> ( match y with O -> 5 | P when h x -> ( function A -> 6)) + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z | P | M -> ( + match y with O -> 5 | P when h x -> ( function A -> 6))); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + (match k with foooo -> foooooooo); + fooooooooooooooo fooooooooooooo) +;; + +match x with +| true -> ( + match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy + when fffffffffffffff bbbbbbbbbb yyyyyyyyyy -> + () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> false + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( + match y with Some _ -> true | None -> false) + in + () + +let () = match fooooo with x -> x + +let () = + match foooo with + | x | x | x -> x + | y | foooooooooo | fooooooooo -> y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) + when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _), + Const (Cfun callee_pname), + (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _, + loc, + _ ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc + +let mod_int c1 c2 is_safe dbg = + match (c1, c2) with + | c1, Cconst_int (0, _) -> + Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x | -1 -> () + +let merge_columns l old_table = + let rec aux = function [] | [ None ] -> ([], []) in + foooooooooooooooooooooooooo fooooooooooooooooooooo + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + ( _, + PStr + [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ] + ) -> + true + | _ -> false + +let () = + match foooo with + | x | x | x -> x + | y | foooooooooo | fooooooooo -> y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa | Bbbbbbbbbbbbbbbbb | Ccccccccccccccccc + | Ddddddddddddddddd | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo + +let () = + match v with + | None -> None + | Some x -> ( + match x with + | None -> None + | Some x -> ( match x with None -> None | Some x -> x)) + +let _ = function (exception A) | B -> 1 | C -> 2 +let _ = function A | (exception B) -> 1 | C -> 2 +let _ = match x with (exception A) | (exception B) -> 1 | C -> 2 + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo) + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> () + end + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () + +let _ = + match x with + | { + y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ); + } -> + () + +let _ = + match x with + | { + y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ); + } -> + () + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo + +let get_nullability = function + | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) + | Undef + (* This is a very special case, assigning non-null is a technical trick *) + -> + Nullability.Nonnull + +let _ = try () with _ -> ( match () with _ -> ()) + +let _ = + let _ = try () with _ -> ( try () with _ -> ()) in + () + +let _ = function _ -> ( x >>= function `Halt -> return x) | _ -> () + +let _ = + let _ = function _ -> ( x >>= function `Halt -> return x) | _ -> () in + () + +class c = + let _ = function _ -> ( x >>= function `Halt -> return x) | _ -> () in + object end diff --git a/test/passing/refs.default/break_collection_expressions-wrap.ml.ref b/test/passing/refs.default/break_collection_expressions-wrap.ml.ref new file mode 100644 index 0000000000..23847339db --- /dev/null +++ b/test/passing/refs.default/break_collection_expressions-wrap.ml.ref @@ -0,0 +1,78 @@ +let _ = + [ + a; + b + (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *); + ] + +let [ + fooooooooooooooooooooooooooooooo; fooooooooooooooooooooooooooooooo; + fooooooooooooooooooooooooooooooo; (* before end of the list *) + ] = + [ + fooooooooooooooooooooooooooooooo; fooooooooooooooooooooooooooooooo; + fooooooooooooooooooooooooooooooo; + (* after all elements *) + (* after all elements as well *) + ] + +let [| + fooooooooooooooooooooooooooooooo; fooooooooooooooooooooooooooooooo; + fooooooooooooooooooooooooooooooo; (* before end of the array *) + |] = + [| + fooooooooooooooooooooooooooooooo; fooooooooooooooooooooooooooooooo; + fooooooooooooooooooooooooooooooo; + (* after all elements *) + (* after all elements as well *) + |] + +let { + fooooooooooooooooooooooooooooooo; + fooooooooooooooooooooooooooooooo; + fooooooooooooooooooooooooooooooo; + _ (* xxx *); + } = + { + fooooooooooooooooooooooooooooooo = x; + fooooooooooooooooooooooooooooooo = y; + fooooooooooooooooooooooooooooooo = z; + (* after all fields *) + } + +let length = + [| + 0; 269999999999999999999999999999999999999999999999999; 26; + (* foo *) 27 (* foo *); 27; 27; + |] + [@foo] + +let length = + [ + 0; 14; (* foo *) 14; 17 (* foo *); 17; 2777777777777777777777777777777777; + 27; + ] + [@foo] + +let length = + [| + 0; 1; 2; 3; 4; 5; 6; 7; 8; 8; 9; 9; 10; 10; 11; 11; 12; 12; 12; 12; 13; 25; + 25; 25; 25; 25; 25; 25; 25; 25; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; + 26; 26; 26; 26; 269999999999999999999999999999999999999999999999999; 26; 26; + 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 27; 27; 27; 27; 27; + 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; + (* foo *) 27 (* foo *); 27; 27; 27; 27; 27; 27; 27; 27; 27; 28; + |] + [@foo] + +let length = + [ + 0; 1; 2; 3; 4; 5; 6; 7; 8; 8; 9; 9; 10; 10; 11; 11; 12; 12; 12; 12; 13; 13; + 13; 13; 14; 14; 14; (* foo *) 14; 15; 15; 15; 15; 16; 16; 16; 16; 16; 16; + 16; 16; 17; 17; 17; 17 (* foo *); 17; 17; 17; 17; 18; 18; 18; 18; 18; 18; + 18; 18; 19; 19; 19; 19; 19; 19; 19; 19; 20; 20; 20; 20; 20; 20; 20; 20; 20; + 20; 20; 26; 26; 26; 26; 26; 27; 27; 27; 27; + 2777777777777777777777777777777777; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; + 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 28; + ] + [@foo] diff --git a/test/passing/refs.default/break_collection_expressions.ml.ref b/test/passing/refs.default/break_collection_expressions.ml.ref new file mode 100644 index 0000000000..d30d5fd4f8 --- /dev/null +++ b/test/passing/refs.default/break_collection_expressions.ml.ref @@ -0,0 +1,288 @@ +let _ = + [ + a; + b + (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *); + ] + +let [ + fooooooooooooooooooooooooooooooo; + fooooooooooooooooooooooooooooooo; + fooooooooooooooooooooooooooooooo; + (* before end of the list *) + ] = + [ + fooooooooooooooooooooooooooooooo; + fooooooooooooooooooooooooooooooo; + fooooooooooooooooooooooooooooooo; + (* after all elements *) + (* after all elements as well *) + ] + +let [| + fooooooooooooooooooooooooooooooo; + fooooooooooooooooooooooooooooooo; + fooooooooooooooooooooooooooooooo; + (* before end of the array *) + |] = + [| + fooooooooooooooooooooooooooooooo; + fooooooooooooooooooooooooooooooo; + fooooooooooooooooooooooooooooooo; + (* after all elements *) + (* after all elements as well *) + |] + +let { + fooooooooooooooooooooooooooooooo; + fooooooooooooooooooooooooooooooo; + fooooooooooooooooooooooooooooooo; + _ (* xxx *); + } = + { + fooooooooooooooooooooooooooooooo = x; + fooooooooooooooooooooooooooooooo = y; + fooooooooooooooooooooooooooooooo = z; + (* after all fields *) + } + +let length = + [| + 0; + 269999999999999999999999999999999999999999999999999; + 26; + (* foo *) 27 (* foo *); + 27; + 27; + |] + [@foo] + +let length = + [ + 0; + 14; + (* foo *) + 14; + 17 (* foo *); + 17; + 2777777777777777777777777777777777; + 27; + ] + [@foo] + +let length = + [| + 0; + 1; + 2; + 3; + 4; + 5; + 6; + 7; + 8; + 8; + 9; + 9; + 10; + 10; + 11; + 11; + 12; + 12; + 12; + 12; + 13; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 269999999999999999999999999999999999999999999999999; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 26; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + (* foo *) 27 (* foo *); + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 28; + |] + [@foo] + +let length = + [ + 0; + 1; + 2; + 3; + 4; + 5; + 6; + 7; + 8; + 8; + 9; + 9; + 10; + 10; + 11; + 11; + 12; + 12; + 12; + 12; + 13; + 13; + 13; + 13; + 14; + 14; + 14; + (* foo *) + 14; + 15; + 15; + 15; + 15; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 17; + 17; + 17; + 17 (* foo *); + 17; + 17; + 17; + 17; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 19; + 19; + 19; + 19; + 19; + 19; + 19; + 19; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 26; + 26; + 26; + 26; + 26; + 27; + 27; + 27; + 27; + 2777777777777777777777777777777777; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 28; + ] + [@foo] diff --git a/test/passing/refs.default/break_colon-before.ml.ref b/test/passing/refs.default/break_colon-before.ml.ref new file mode 100644 index 0000000000..e05840029b --- /dev/null +++ b/test/passing/refs.default/break_colon-before.ml.ref @@ -0,0 +1,92 @@ +(* Bad: unboxing the function type *) +external i : (int -> float[@unboxed]) = "i" "i_nat" + +module type M = sig + val action : action + (** Formatting action: input type and source, and output destination. *) + + val doc_atrs + : (string Location.loc * payload) list -> + (string Location.loc * bool) list option + * (string Location.loc * payload) list + + val transl_modtype_longident (* from Typemod *) + : (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val transl_modtype_longident + (* foooooooooo fooooooooooooo foooooooooooo foooooooooooooo + foooooooooooooo foooooooooooo *) + : (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val imported_sets_of_closures_table + : Simple_value_approx.function_declarations option Set_of_closures_id.Tbl.t + + type 'a option_decl = + names:string list -> + doc:string -> + section:[ `Formatting | `Operational ] -> + ?allow_inline:bool -> + (config -> 'a -> config) -> + (config -> 'a) -> + 'a t + + val select + : (* The fsevents context *) + env -> + (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list -> + (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list -> + (* Timeout...like Unix.select *) + timeout:float -> + (* The callback for file system events *) + (event list -> unit) -> + unit + + val f + : x:t + (** an extremely long comment about [x] that does not fit on the same + line with [x] *) -> + unit + + val f + : fooooooooooooooooo: + (fooooooooooooooo -> + fooooooooooooooooooo -> + foooooooooooooo -> + foooooooooooooo * fooooooooooooooooo -> + foooooooooooooooo) + (** an extremely long comment about [x] that does not fit on the same + line with [x] *) -> + unit +end + +let ssmap + : (module MapT + with type key = string + and type data = string + and type map = SSMap.map) = + () + +let ssmap + : (module MapT + with type key = string + and type data = string + and type map = SSMap.map) -> + unit = + () + +let long_function_name + : type a. a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit = + fun () -> () + +let array_fold_transf (f : numbering -> 'a -> numbering * 'b) n (a : 'a array) + : numbering * 'b array = + match Array.length a with 0 -> (n, [||]) | 1 -> x + +let to_clambda_function (id, (function_decl : Flambda.function_declaration)) + : Clambda.ufunction = + (* All that we need in the environment, for translating one closure from a + closed set of closures, is the substitutions for variables bound to the + various closures in the set. Such closures will always be ... *) + x diff --git a/test/passing/refs.default/break_colon.ml.ref b/test/passing/refs.default/break_colon.ml.ref new file mode 100644 index 0000000000..b3eb53cf06 --- /dev/null +++ b/test/passing/refs.default/break_colon.ml.ref @@ -0,0 +1,92 @@ +(* Bad: unboxing the function type *) +external i : (int -> float[@unboxed]) = "i" "i_nat" + +module type M = sig + val action : action + (** Formatting action: input type and source, and output destination. *) + + val doc_atrs : + (string Location.loc * payload) list -> + (string Location.loc * bool) list option + * (string Location.loc * payload) list + + val transl_modtype_longident (* from Typemod *) : + (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val transl_modtype_longident + (* foooooooooo fooooooooooooo foooooooooooo foooooooooooooo + foooooooooooooo foooooooooooo *) : + (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val imported_sets_of_closures_table : + Simple_value_approx.function_declarations option Set_of_closures_id.Tbl.t + + type 'a option_decl = + names:string list -> + doc:string -> + section:[ `Formatting | `Operational ] -> + ?allow_inline:bool -> + (config -> 'a -> config) -> + (config -> 'a) -> + 'a t + + val select : + (* The fsevents context *) + env -> + (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list -> + (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list -> + (* Timeout...like Unix.select *) + timeout:float -> + (* The callback for file system events *) + (event list -> unit) -> + unit + + val f : + x:t + (** an extremely long comment about [x] that does not fit on the same line + with [x] *) -> + unit + + val f : + fooooooooooooooooo: + (fooooooooooooooo -> + fooooooooooooooooooo -> + foooooooooooooo -> + foooooooooooooo * fooooooooooooooooo -> + foooooooooooooooo) + (** an extremely long comment about [x] that does not fit on the same line + with [x] *) -> + unit +end + +let ssmap : + (module MapT + with type key = string + and type data = string + and type map = SSMap.map) = + () + +let ssmap : + (module MapT + with type key = string + and type data = string + and type map = SSMap.map) -> + unit = + () + +let long_function_name : type a. + a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit = + fun () -> () + +let array_fold_transf (f : numbering -> 'a -> numbering * 'b) n (a : 'a array) : + numbering * 'b array = + match Array.length a with 0 -> (n, [||]) | 1 -> x + +let to_clambda_function (id, (function_decl : Flambda.function_declaration)) : + Clambda.ufunction = + (* All that we need in the environment, for translating one closure from a + closed set of closures, is the substitutions for variables bound to the + various closures in the set. Such closures will always be ... *) + x diff --git a/test/passing/refs.default/break_fun_decl-fit_or_vertical.ml.ref b/test/passing/refs.default/break_fun_decl-fit_or_vertical.ml.ref new file mode 100644 index 0000000000..8db9307d60 --- /dev/null +++ b/test/passing/refs.default/break_fun_decl-fit_or_vertical.ml.ref @@ -0,0 +1,150 @@ +class t = + object + method meth + aaaaaaaaaaa + bbbbbbbbbbbbbb + ccccccccccccccccccc + ddddddddddddddddddddd + eeeeeeeeeeeeeee = + body + end + +let func + aaaaaaaaaaa + bbbbbbbbbbbbbb + ccccccccccccccccccc + ddddddddddddddddddddd + eeeeeeeeeeeeeee = + body + +let rec func + aaaaaaaaaaa + bbbbbbbbbbbbbb + ccccccccccccccccccc + ddddddddddddddddddddd + eeeeeeeeeeeeeee = + body + +let ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc = + g + +let ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc + dddddddddddddddddddddd = + g + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +class ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc = g + +class ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc + dddddddddddddddddddddd = g + +let ffffffffffffffffffff : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb -> cccccccccccccccccccccc = + g + +let ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd = + g + +let fffffffffffffffffffffffffffffffffff x yyyyyyyyyyyyyyyyyyyyyyyyyyy = () + +let fffffffffffffffffffffffffffffffffff + x + yyyyyyyyyyyyyyyyyyyyyyyyyyy + yyyyyyyyyyyyyyyyyyyyyyyyyyy = + () + +class ffffffffffffffffffff = + object + method ffffffffffffffffffff + : + aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd = + g + + val ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd = + g + end + +class type ffffffffffffffffffff = object + method ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd + + val ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd + + val ffffffffffffffffffff : + (aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd) -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd +end + +let _ = + fun (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) -> + body + +let _ = + f + (fun + (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) + -> body) + +let f + (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) = + body + +(* Inconsistent formatting of fun arguments. *) + +let new_specialised_args = + Variable.Map.mapi + (fun new_inner_var______ (definition : Definition.t) : + Flambda.specialised_to -> ()) + foo + +let new_specialised_args = + Variable.Map.mapi + (fun + new_inner_var______ + (definition : Definition.t) + : + Flambda.specialised_to + -> ()) diff --git a/test/passing/refs.default/break_fun_decl-smart.ml.ref b/test/passing/refs.default/break_fun_decl-smart.ml.ref new file mode 100644 index 0000000000..69cd16da9f --- /dev/null +++ b/test/passing/refs.default/break_fun_decl-smart.ml.ref @@ -0,0 +1,143 @@ +class t = + object + method meth + aaaaaaaaaaa + bbbbbbbbbbbbbb + ccccccccccccccccccc + ddddddddddddddddddddd + eeeeeeeeeeeeeee = + body + end + +let func + aaaaaaaaaaa + bbbbbbbbbbbbbb + ccccccccccccccccccc + ddddddddddddddddddddd + eeeeeeeeeeeeeee = + body + +let rec func + aaaaaaaaaaa + bbbbbbbbbbbbbb + ccccccccccccccccccc + ddddddddddddddddddddd + eeeeeeeeeeeeeee = + body + +let ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccc = + g + +let ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc + dddddddddddddddddddddd = + g + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +class ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccc = g + +class ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc + dddddddddddddddddddddd = g + +let ffffffffffffffffffff : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb -> cccccccccccccccccccccc = + g + +let ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd = + g + +let fffffffffffffffffffffffffffffffffff x yyyyyyyyyyyyyyyyyyyyyyyyyyy = () + +let fffffffffffffffffffffffffffffffffff + x yyyyyyyyyyyyyyyyyyyyyyyyyyy yyyyyyyyyyyyyyyyyyyyyyyyyyy = + () + +class ffffffffffffffffffff = + object + method ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd = + g + + val ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd = + g + end + +class type ffffffffffffffffffff = object + method ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd + + val ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd + + val ffffffffffffffffffff : + (aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd) -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd +end + +let _ = + fun (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) -> + body + +let _ = + f + (fun + (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) + -> body) + +let f + (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) = + body + +(* Inconsistent formatting of fun arguments. *) + +let new_specialised_args = + Variable.Map.mapi + (fun new_inner_var______ (definition : Definition.t) : + Flambda.specialised_to -> ()) + foo + +let new_specialised_args = + Variable.Map.mapi + (fun + new_inner_var______ + (definition : Definition.t) + : + Flambda.specialised_to + -> ()) diff --git a/test/passing/refs.default/break_fun_decl-wrap.ml.ref b/test/passing/refs.default/break_fun_decl-wrap.ml.ref new file mode 100644 index 0000000000..ac9b92e95f --- /dev/null +++ b/test/passing/refs.default/break_fun_decl-wrap.ml.ref @@ -0,0 +1,124 @@ +class t = + object + method meth aaaaaaaaaaa bbbbbbbbbbbbbb ccccccccccccccccccc + ddddddddddddddddddddd eeeeeeeeeeeeeee = + body + end + +let func aaaaaaaaaaa bbbbbbbbbbbbbb ccccccccccccccccccc ddddddddddddddddddddd + eeeeeeeeeeeeeee = + body + +let rec func aaaaaaaaaaa bbbbbbbbbbbbbb ccccccccccccccccccc + ddddddddddddddddddddd eeeeeeeeeeeeeee = + body + +let ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc = + g + +let ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc dddddddddddddddddddddd = + g + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc = g + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc dddddddddddddddddddddd = g + +let ffffffffffffffffffff : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb -> cccccccccccccccccccccc = + g + +let ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd = + g + +let fffffffffffffffffffffffffffffffffff x yyyyyyyyyyyyyyyyyyyyyyyyyyy = () + +let fffffffffffffffffffffffffffffffffff x yyyyyyyyyyyyyyyyyyyyyyyyyyy + yyyyyyyyyyyyyyyyyyyyyyyyyyy = + () + +class ffffffffffffffffffff = + object + method ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd = + g + + val ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd = + g + end + +class type ffffffffffffffffffff = object + method ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd + + val ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd + + val ffffffffffffffffffff : + (aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd) -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd +end + +let _ = + fun (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) -> + body + +let _ = + f + (fun + (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) + -> body) + +let f (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) = + body + +(* Inconsistent formatting of fun arguments. *) + +let new_specialised_args = + Variable.Map.mapi + (fun new_inner_var______ (definition : Definition.t) : + Flambda.specialised_to -> ()) + foo + +let new_specialised_args = + Variable.Map.mapi + (fun + new_inner_var______ + (definition : Definition.t) + : + Flambda.specialised_to + -> ()) diff --git a/test/passing/refs.default/break_fun_decl.ml.ref b/test/passing/refs.default/break_fun_decl.ml.ref new file mode 100644 index 0000000000..ac9b92e95f --- /dev/null +++ b/test/passing/refs.default/break_fun_decl.ml.ref @@ -0,0 +1,124 @@ +class t = + object + method meth aaaaaaaaaaa bbbbbbbbbbbbbb ccccccccccccccccccc + ddddddddddddddddddddd eeeeeeeeeeeeeee = + body + end + +let func aaaaaaaaaaa bbbbbbbbbbbbbb ccccccccccccccccccc ddddddddddddddddddddd + eeeeeeeeeeeeeee = + body + +let rec func aaaaaaaaaaa bbbbbbbbbbbbbb ccccccccccccccccccc + ddddddddddddddddddddd eeeeeeeeeeeeeee = + body + +let ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc = + g + +let ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc dddddddddddddddddddddd = + g + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc = g + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc dddddddddddddddddddddd = g + +let ffffffffffffffffffff : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb -> cccccccccccccccccccccc = + g + +let ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd = + g + +let fffffffffffffffffffffffffffffffffff x yyyyyyyyyyyyyyyyyyyyyyyyyyy = () + +let fffffffffffffffffffffffffffffffffff x yyyyyyyyyyyyyyyyyyyyyyyyyyy + yyyyyyyyyyyyyyyyyyyyyyyyyyy = + () + +class ffffffffffffffffffff = + object + method ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd = + g + + val ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd = + g + end + +class type ffffffffffffffffffff = object + method ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd + + val ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd + + val ffffffffffffffffffff : + (aaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd) -> + bbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccc -> + dddddddddddddddddddddd +end + +let _ = + fun (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) -> + body + +let _ = + f + (fun + (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) + -> body) + +let f (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) = + body + +(* Inconsistent formatting of fun arguments. *) + +let new_specialised_args = + Variable.Map.mapi + (fun new_inner_var______ (definition : Definition.t) : + Flambda.specialised_to -> ()) + foo + +let new_specialised_args = + Variable.Map.mapi + (fun + new_inner_var______ + (definition : Definition.t) + : + Flambda.specialised_to + -> ()) diff --git a/test/passing/refs.default/break_infix-fit-or-vertical.ml.err b/test/passing/refs.default/break_infix-fit-or-vertical.ml.err new file mode 100644 index 0000000000..7a5a6543fb --- /dev/null +++ b/test/passing/refs.default/break_infix-fit-or-vertical.ml.err @@ -0,0 +1 @@ +Warning: break_infix-fit-or-vertical.ml:54 exceeds the margin diff --git a/test/passing/refs.default/break_infix-fit-or-vertical.ml.ref b/test/passing/refs.default/break_infix-fit-or-vertical.ml.ref new file mode 100644 index 0000000000..39af766387 --- /dev/null +++ b/test/passing/refs.default/break_infix-fit-or-vertical.ml.ref @@ -0,0 +1,128 @@ +let _ = + get_succs parent + |> Sequence.of_list + |> Sequence.filter ~f:(fun n -> not (equal node n)) + |> Sequence.Generator.of_sequence + +let git_clone ~branch ~remote ~output_dir = + run_and_log + Cmd.( + v "git" + % "clone" + % "--depth" + % "1" + % "--branch" + % branch + % remote + % p output_dir) + +let all_6_2char_hex a b c d e f = + is_2char_hex a + && is_2char_hex b + && is_2char_hex c + && is_2char_hex d + && is_2char_hex e + && is_2char_hex f + +let pf0 = + let open Utils.Parallel_folders in + open_ construct + |+ misc_stats_folder header + |+ elapsed_wall_over_blocks_folder header block_count + |+ elapsed_cpu_over_blocks_folder header block_count + |+ Span_folder.create header.initial_stats.timestamp_wall block_count + |+ cpu_usage_folder header block_count + |+ (pack_folder + && foooooooooooooooooooo + && foooooooooooooooooooo + && foooooooooooooooooooo) + |+ tree_folder + @ foooooooooooooooooooo + @ foooooooooooooooooooo + @ foooooooooooooooooooo + |+ index_folder + + foooooooooooooooooooo + + foooooooooooooooooooo + + foooooooooooooooooooo + |+ gc_folder + * foooooooooooooooooooo + * foooooooooooooooooooo + * foooooooooooooooooooo + |+ disk_folder + |> seal + +let cmd = + root ^ ("_build" / "default" / Fmt.str "%s serve %d %d &" Sys.argv.(0) i id.id) + +let _ = + a b c + :: fooo fooooooooo fooo + :: x y zzzzzzz + :: ("aaa" + ^ "bbb" + ^ "cccccc" + ^ "dddddddddd" + ^ "eeeeeeeeeeeeee" + ^ "ffffffffffffff") + :: foooooo + :: [ ffffffffff; ooooooooo ] + +let _ = + fooooooooo + @@ fooooooooooooooo + @@ (fun x -> foooooooooooooo $ fooooooooooooooooooooo) + @@ fun x -> + fooooooooooooooo + $ fooooooooooooooooo + $ fooooooooooooooooo + $ fooooooooooooo + $ fooo @@ foooooooooooooooooo + $ fooooooooooooo + $ foooooooooooooooooooo + +let _ = a + (b * c) + d + +let _ = + a + + (b * c) + + d + + (b * c) + + d + + (b * c) + + d + + (b * c) + + d + + (b * c) + + (b * c) + + (b * c) + +(* Break infix if followed by let or letop *) + +let term = + Term.ret + @@ let+ config = Common.config_term + and+ mode = + Arg.( + value + & pos 0 (some (enum modes)) None + & info [] ~docv:"ACTION" + ~doc: + (Printf.sprintf "The cache-daemon action to perform (%s)" + (Arg.doc_alts_enum modes))) + in + (config, mode) + +let term = + Term.ret + @@ + let config = Common.config_term + and mode = + Arg.( + value + & pos 0 (some (enum modes)) None + & info [] ~docv:"ACTION" + ~doc: + (Printf.sprintf "The cache-daemon action to perform (%s)" + (Arg.doc_alts_enum modes))) + in + (config, mode) diff --git a/test/passing/refs.default/break_infix-wrap.ml.err b/test/passing/refs.default/break_infix-wrap.ml.err new file mode 100644 index 0000000000..447de828f8 --- /dev/null +++ b/test/passing/refs.default/break_infix-wrap.ml.err @@ -0,0 +1 @@ +Warning: break_infix-wrap.ml:33 exceeds the margin diff --git a/test/passing/refs.default/break_infix-wrap.ml.ref b/test/passing/refs.default/break_infix-wrap.ml.ref new file mode 100644 index 0000000000..7d9f249020 --- /dev/null +++ b/test/passing/refs.default/break_infix-wrap.ml.ref @@ -0,0 +1,85 @@ +let _ = + get_succs parent |> Sequence.of_list + |> Sequence.filter ~f:(fun n -> not (equal node n)) + |> Sequence.Generator.of_sequence + +let git_clone ~branch ~remote ~output_dir = + run_and_log + Cmd.( + v "git" % "clone" % "--depth" % "1" % "--branch" % branch % remote + % p output_dir) + +let all_6_2char_hex a b c d e f = + is_2char_hex a && is_2char_hex b && is_2char_hex c && is_2char_hex d + && is_2char_hex e && is_2char_hex f + +let pf0 = + let open Utils.Parallel_folders in + open_ construct |+ misc_stats_folder header + |+ elapsed_wall_over_blocks_folder header block_count + |+ elapsed_cpu_over_blocks_folder header block_count + |+ Span_folder.create header.initial_stats.timestamp_wall block_count + |+ cpu_usage_folder header block_count + |+ (pack_folder && foooooooooooooooooooo && foooooooooooooooooooo + && foooooooooooooooooooo) + |+ tree_folder @ foooooooooooooooooooo @ foooooooooooooooooooo + @ foooooooooooooooooooo + |+ index_folder + foooooooooooooooooooo + foooooooooooooooooooo + + foooooooooooooooooooo + |+ gc_folder * foooooooooooooooooooo * foooooooooooooooooooo + * foooooooooooooooooooo + |+ disk_folder |> seal + +let cmd = + root ^ ("_build" / "default" / Fmt.str "%s serve %d %d &" Sys.argv.(0) i id.id) + +let _ = + a b c :: fooo fooooooooo fooo :: x y zzzzzzz + :: ("aaa" ^ "bbb" ^ "cccccc" ^ "dddddddddd" ^ "eeeeeeeeeeeeee" + ^ "ffffffffffffff") + :: foooooo :: [ ffffffffff; ooooooooo ] + +let _ = + fooooooooo @@ fooooooooooooooo + @@ (fun x -> foooooooooooooo $ fooooooooooooooooooooo) + @@ fun x -> + fooooooooooooooo $ fooooooooooooooooo $ fooooooooooooooooo $ fooooooooooooo + $ fooo @@ foooooooooooooooooo + $ fooooooooooooo $ foooooooooooooooooooo + +let _ = a + (b * c) + d + +let _ = + a + (b * c) + d + (b * c) + d + (b * c) + d + (b * c) + d + (b * c) + (b * c) + + (b * c) + +(* Break infix if followed by let or letop *) + +let term = + Term.ret + @@ let+ config = Common.config_term + and+ mode = + Arg.( + value + & pos 0 (some (enum modes)) None + & info [] ~docv:"ACTION" + ~doc: + (Printf.sprintf "The cache-daemon action to perform (%s)" + (Arg.doc_alts_enum modes))) + in + (config, mode) + +let term = + Term.ret + @@ + let config = Common.config_term + and mode = + Arg.( + value + & pos 0 (some (enum modes)) None + & info [] ~docv:"ACTION" + ~doc: + (Printf.sprintf "The cache-daemon action to perform (%s)" + (Arg.doc_alts_enum modes))) + in + (config, mode) diff --git a/test/passing/refs.default/break_infix.ml.err b/test/passing/refs.default/break_infix.ml.err new file mode 100644 index 0000000000..638da996cc --- /dev/null +++ b/test/passing/refs.default/break_infix.ml.err @@ -0,0 +1 @@ +Warning: break_infix.ml:48 exceeds the margin diff --git a/test/passing/refs.default/break_infix.ml.ref b/test/passing/refs.default/break_infix.ml.ref new file mode 100644 index 0000000000..a739a7d08b --- /dev/null +++ b/test/passing/refs.default/break_infix.ml.ref @@ -0,0 +1,117 @@ +let _ = + get_succs parent + |> Sequence.of_list + |> Sequence.filter ~f:(fun n -> not (equal node n)) + |> Sequence.Generator.of_sequence + +let git_clone ~branch ~remote ~output_dir = + run_and_log + Cmd.( + v "git" + % "clone" + % "--depth" + % "1" + % "--branch" + % branch + % remote + % p output_dir) + +let all_6_2char_hex a b c d e f = + is_2char_hex a + && is_2char_hex b + && is_2char_hex c + && is_2char_hex d + && is_2char_hex e + && is_2char_hex f + +let pf0 = + let open Utils.Parallel_folders in + open_ construct + |+ misc_stats_folder header + |+ elapsed_wall_over_blocks_folder header block_count + |+ elapsed_cpu_over_blocks_folder header block_count + |+ Span_folder.create header.initial_stats.timestamp_wall block_count + |+ cpu_usage_folder header block_count + |+ (pack_folder + && foooooooooooooooooooo + && foooooooooooooooooooo + && foooooooooooooooooooo) + |+ tree_folder @ foooooooooooooooooooo @ foooooooooooooooooooo + @ foooooooooooooooooooo + |+ index_folder + foooooooooooooooooooo + foooooooooooooooooooo + + foooooooooooooooooooo + |+ gc_folder * foooooooooooooooooooo * foooooooooooooooooooo + * foooooooooooooooooooo + |+ disk_folder + |> seal + +let cmd = + root ^ ("_build" / "default" / Fmt.str "%s serve %d %d &" Sys.argv.(0) i id.id) + +let _ = + a b c + :: fooo fooooooooo fooo + :: x y zzzzzzz + :: ("aaa" ^ "bbb" ^ "cccccc" ^ "dddddddddd" ^ "eeeeeeeeeeeeee" + ^ "ffffffffffffff") + :: foooooo + :: [ ffffffffff; ooooooooo ] + +let _ = + fooooooooo @@ fooooooooooooooo + @@ (fun x -> foooooooooooooo $ fooooooooooooooooooooo) + @@ fun x -> + fooooooooooooooo + $ fooooooooooooooooo + $ fooooooooooooooooo + $ fooooooooooooo + $ fooo @@ foooooooooooooooooo + $ fooooooooooooo + $ foooooooooooooooooooo + +let _ = a + (b * c) + d + +let _ = + a + + (b * c) + + d + + (b * c) + + d + + (b * c) + + d + + (b * c) + + d + + (b * c) + + (b * c) + + (b * c) + +(* Break infix if followed by let or letop *) + +let term = + Term.ret + @@ let+ config = Common.config_term + and+ mode = + Arg.( + value + & pos 0 (some (enum modes)) None + & info [] ~docv:"ACTION" + ~doc: + (Printf.sprintf "The cache-daemon action to perform (%s)" + (Arg.doc_alts_enum modes))) + in + (config, mode) + +let term = + Term.ret + @@ + let config = Common.config_term + and mode = + Arg.( + value + & pos 0 (some (enum modes)) None + & info [] ~docv:"ACTION" + ~doc: + (Printf.sprintf "The cache-daemon action to perform (%s)" + (Arg.doc_alts_enum modes))) + in + (config, mode) diff --git a/test/passing/refs.default/break_record.ml.ref b/test/passing/refs.default/break_record.ml.ref new file mode 100644 index 0000000000..3c103e746b --- /dev/null +++ b/test/passing/refs.default/break_record.ml.ref @@ -0,0 +1,6 @@ +let xxxxxxxxxxxxxxxxxxxxxx x = + { + xxxxxxxxxxxxxx; + xxxxxxxxxxxxxxxxxx = x; + xxxxxxxxxxxxx; + } diff --git a/test/passing/refs.default/break_separators-after.ml.ref b/test/passing/refs.default/break_separators-after.ml.ref new file mode 100644 index 0000000000..72075b35c6 --- /dev/null +++ b/test/passing/refs.default/break_separators-after.ml.ref @@ -0,0 +1,434 @@ +type t = { + (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooo : foooooooooooooooooooooooooooooooooooooooo; + (* foooooooooooooooooooooooooooooooooooooooooooo *) + fooooooooooooooooooooooooooooo : fooooooooooooooooooooooooooo; +} + +type x = + | B of { + (* fooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaa; + (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbbbbb; + } + +type t = { + aaaaaaaaaaaaaaaaaaaaaaaaa : aaaa aaaaaaaaaaaaaaaaaaa; + bbbbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbb bbbb; + cccccccccccccccccccccc : ccccccc ccccccccccc cccccccc; +} + +type x = + | B of { + aaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaa; + bbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbbbbb; + } + +type t = { + break_cases : [ `Fit | `Nested | `All ]; + break_collection_expressions : [ `Wrap | `Fit_or_vertical ]; + break_infix : [ `Wrap | `Fit_or_vertical ]; + break_separators : bool; + break_sequences : bool; + break_string_literals : [ `Newlines | `Never | `Wrap ]; + (** How to potentially break string literals into new lines. *) + break_struct : bool; + cases_exp_indent : int; + comment_check : bool; + disable : bool; + doc_comments : [ `Before | `After ]; + escape_chars : [ `Decimal | `Hexadecimal | `Preserve ]; + (** Escape encoding for chars literals. *) + escape_strings : [ `Decimal | `Hexadecimal | `Preserve ]; + (** Escape encoding for string literals. *) + extension_sugar : [ `Preserve | `Always ]; + field_space : [ `Tight | `Loose ]; + if_then_else : [ `Compact | `Keyword_first ]; + indicate_multiline_delimiters : bool; + indicate_nested_or_patterns : bool; + infix_precedence : [ `Indent | `Parens ]; + leading_nested_match_parens : bool; + let_and : [ `Compact | `Sparse ]; + let_binding_spacing : [ `Compact | `Sparse | `Double_semicolon ]; + let_open : [ `Preserve | `Auto | `Short | `Long ]; + margin : int; (** Format code to fit within [margin] columns. *) + max_iters : int; + (** Fail if output of formatting does not stabilize within [max_iters] + iterations. *) + module_item_spacing : [ `Compact | `Sparse ]; + ocp_indent_compat : bool; (** Try to indent like ocp-indent *) + parens_ite : bool; + parens_tuple : [ `Always | `Multi_line_only ]; + parens_tuple_patterns : [ `Always | `Multi_line_only ]; + parse_docstrings : bool; + quiet : bool; + sequence_style : [ `Separator | `Terminator ]; + single_case : [ `Compact | `Sparse ]; + type_decl : [ `Compact | `Sparse ]; + wrap_comments : bool; (** Wrap comments at margin. *) + wrap_fun_args : bool; +} + +let _ = + match something with + | { + very_very_long_field_name_running_out_of_space = 1; + another_very_very_long_field_name_running_out_of_space = 2; + _; + } -> + 0 + | _ -> 1 + +let _ = + match something with + | [ + very_very_long_field_name_running_out_of_space; + another_very_very_long_field_name_running_out_of_space; + _; + ] -> + 0 + | _ -> 1 + +let _ = + match something with + | [| + very_very_long_field_name_running_out_of_space; + another_very_very_long_field_name_running_out_of_space; + _; + |] -> + 0 + | _ -> 1 + +[@@@ocamlformat "type-decl=compact"] + +type t = { aaaaaaaaa : aaaa; bbbbbbbbb : bbbb } + +type trace_mod_funs = { + trace_mod : bool option; + trace_funs : bool Map.M(String).t; +} + +[@@@ocamlformat "type-decl=sparse"] + +module X = struct + val select : + (* The fsevents context *) + env -> + (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list -> + (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list -> + (* Timeout...like Unix.select *) + timeout:float -> + (* The callback for file system events *) + (event list -> unit) -> + unit +end + +type t = { + aaaaaaaaa : aaaa; + bbbbbbbbb : bbbb; +} + +type trace_mod_funs = { + trace_mod : bool option; + trace_funs : bool Map.M(String).t; +} + +let x { aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa } = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb = bbb bb bbbbbb } + +let x + { + aaaaaaaaaaaaaaaaaaaaaa; + aaaaaaaaaaaaaaaaaaa; + aaaaaaaaaaaaaa; + aaaaaaaaaaaaaaaaaa; + aaaaaaaaaa; + } = + { + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; + bbbbbbbbbbbbb = bbb bb bbbbbb; + cccccc = cccc ccccccccccccccccccccccc; + } + +(* this is an array *) +let length = + [| + 0; + 269999999999999999999999999999999999999999999999999; + 26; + (* foo *) 27 (* foo *); + 27; + 27; + |] + [@foo] + +(* this is a list *) +let length = + [ + 0; + 14; + (* foo *) + 14; + 17 (* foo *); + 17; + 2777777777777777777777777777777777; + 27; + ] + [@foo] +;; + +Fooooooo.foo ~foooooooooooooo ~fooooooooo:"" + (Foo.foo ~foo ~foo ~foooo:() + [ + ("fooooo", Foo.fooo ~foooo ~foooo:(foooo >*> fooooo)); + ("foooo", fooooooo); + ("foooooo", foooooooo); + ("fooooooooo", foooooooo); + ]) + +class + [ 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, + 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ] + x = + [ 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, + 'yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy ] + k + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ( 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, + 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ) + e + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ('aaaaaaaaa, 'bbbbbbbbbbbb) e + +let ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, + yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy, + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz, + (aaaaaaaaaaaa, bbbbbbbbbbbb) ) = + ( ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, + yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy, + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz ), + (aaaaaaaaaaaaaa, bbbbbbbbbbbb) ) + +type t = aaaaaaaaaaaa -> bbbbbbbbbbbb -> cccccccccc + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb -> + ccccccccccccccccccccccccc + +type t = + (* foooooooooooo *) + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + (* foooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb -> + (* fooooooooooooooooo *) + ccccccccccccccccccccccccc -> + (* foooooo *) + foo * [ `Foo of foo * foo ] -> + (* foooooooooooooooo *) + foo + * foo + * foo + * foo + * [ `Foo of + (* fooooooooooooooooooo *) + foo * foo * foo -> + foo -> + foo -> + (* foooooooooooo *) + foo -> + foo -> + foo * foo -> + foo * foo -> + foo * foo + ] -> + (* foooooooooooooooo *) + fooooooooooooooooo + +type t = { + (* fooooooooooooooooo *) + foo : foo; + (* foooooooooooooooooooooo fooooooooooooooooooo fooooooooooooooo + foooooooooooooooooo foooooooooooooooo *) + foo : + (* fooooooooooooooooooo *) + foooooooooooo -> + (* foooooooooooooo *) + foooooooooooooooo -> + foooooooooooooo -> + foooooooooo -> + fooooooooooooooo; + foo : foo; +} + +[@@@ocamlformat "ocp-indent-compat"] + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb -> + ccccccccccccccccccccccccc + +type t = + (string Location.loc * payload) list -> + (string Location.loc * bool) list option + * (string Location.loc * payload) list -> + (string Location.loc * bool) list option + * (string Location.loc * payload) list -> + (string Location.loc * bool) list option + * (string Location.loc * payload) list + +let x { aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa } = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb = bbb bb bbbbbb } + +let x + { + aaaaaaaaaaaaaaaaaaaaaa; + aaaaaaaaaaaaaaaaaaa; + aaaaaaaaaaaaaa; + aaaaaaaaaaaaaaaaaa; + aaaaaaaaaa; + } + = + { + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; + bbbbbbbbbbbbb = bbb bb bbbbbb; + cccccc = cccc ccccccccccccccccccccccc; + } + +let foooooooooooooooooooooooooooooooooo = + { + (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; + (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + bbbbbbbbbbbbb = bbb bb bbbbbb; + cccccc = cccc ccccccccccccccccccccccc; + } + +let foooooooooooo = + { + foooooooooooooo with + fooooooooooooooooooooooooooooo = fooooooooooooo; + fooooooooooooo = foooooooooooooo; + } + +let foooooooooooo = + { + foooooooooooooo with + (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo + *) + fooooooooooooooooooooooooooooo = fooooooooooooo; + fooooooooooooo = foooooooooooooo; + } + +let fooooooooooo = function + | Pmty_alias lid -> + { + empty with + bdy = fmt_longident_loc c lid; + epi = Some (fmt_attributes c ~key:"@" pmty_attributes ~pre:(fmt "@ ")); + } + +let f () = + let { + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + } + = + some_value + in + foooooooooooo + +let f () = + let [ + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + ] + = + some_value + in + foooooooooooo + +let f () = + let [| + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + |] + = + some_value + in + foooooooooooo + +let g () = + match some_value with + | { + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + } -> + foooooooo + | [ + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + ] -> + fooooooooo + | [| + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + |] -> + fooooooooo + +let () = + match x with + | ( _, + (* line 1 line 2 *) + Some _ ) -> + x + +let () = + match x with + | ( _, + (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1 + veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 + *) + Some _ ) -> + x diff --git a/test/passing/refs.default/break_separators-after_docked.ml.ref b/test/passing/refs.default/break_separators-after_docked.ml.ref new file mode 100644 index 0000000000..72075b35c6 --- /dev/null +++ b/test/passing/refs.default/break_separators-after_docked.ml.ref @@ -0,0 +1,434 @@ +type t = { + (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooo : foooooooooooooooooooooooooooooooooooooooo; + (* foooooooooooooooooooooooooooooooooooooooooooo *) + fooooooooooooooooooooooooooooo : fooooooooooooooooooooooooooo; +} + +type x = + | B of { + (* fooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaa; + (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbbbbb; + } + +type t = { + aaaaaaaaaaaaaaaaaaaaaaaaa : aaaa aaaaaaaaaaaaaaaaaaa; + bbbbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbb bbbb; + cccccccccccccccccccccc : ccccccc ccccccccccc cccccccc; +} + +type x = + | B of { + aaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaa; + bbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbbbbb; + } + +type t = { + break_cases : [ `Fit | `Nested | `All ]; + break_collection_expressions : [ `Wrap | `Fit_or_vertical ]; + break_infix : [ `Wrap | `Fit_or_vertical ]; + break_separators : bool; + break_sequences : bool; + break_string_literals : [ `Newlines | `Never | `Wrap ]; + (** How to potentially break string literals into new lines. *) + break_struct : bool; + cases_exp_indent : int; + comment_check : bool; + disable : bool; + doc_comments : [ `Before | `After ]; + escape_chars : [ `Decimal | `Hexadecimal | `Preserve ]; + (** Escape encoding for chars literals. *) + escape_strings : [ `Decimal | `Hexadecimal | `Preserve ]; + (** Escape encoding for string literals. *) + extension_sugar : [ `Preserve | `Always ]; + field_space : [ `Tight | `Loose ]; + if_then_else : [ `Compact | `Keyword_first ]; + indicate_multiline_delimiters : bool; + indicate_nested_or_patterns : bool; + infix_precedence : [ `Indent | `Parens ]; + leading_nested_match_parens : bool; + let_and : [ `Compact | `Sparse ]; + let_binding_spacing : [ `Compact | `Sparse | `Double_semicolon ]; + let_open : [ `Preserve | `Auto | `Short | `Long ]; + margin : int; (** Format code to fit within [margin] columns. *) + max_iters : int; + (** Fail if output of formatting does not stabilize within [max_iters] + iterations. *) + module_item_spacing : [ `Compact | `Sparse ]; + ocp_indent_compat : bool; (** Try to indent like ocp-indent *) + parens_ite : bool; + parens_tuple : [ `Always | `Multi_line_only ]; + parens_tuple_patterns : [ `Always | `Multi_line_only ]; + parse_docstrings : bool; + quiet : bool; + sequence_style : [ `Separator | `Terminator ]; + single_case : [ `Compact | `Sparse ]; + type_decl : [ `Compact | `Sparse ]; + wrap_comments : bool; (** Wrap comments at margin. *) + wrap_fun_args : bool; +} + +let _ = + match something with + | { + very_very_long_field_name_running_out_of_space = 1; + another_very_very_long_field_name_running_out_of_space = 2; + _; + } -> + 0 + | _ -> 1 + +let _ = + match something with + | [ + very_very_long_field_name_running_out_of_space; + another_very_very_long_field_name_running_out_of_space; + _; + ] -> + 0 + | _ -> 1 + +let _ = + match something with + | [| + very_very_long_field_name_running_out_of_space; + another_very_very_long_field_name_running_out_of_space; + _; + |] -> + 0 + | _ -> 1 + +[@@@ocamlformat "type-decl=compact"] + +type t = { aaaaaaaaa : aaaa; bbbbbbbbb : bbbb } + +type trace_mod_funs = { + trace_mod : bool option; + trace_funs : bool Map.M(String).t; +} + +[@@@ocamlformat "type-decl=sparse"] + +module X = struct + val select : + (* The fsevents context *) + env -> + (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list -> + (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list -> + (* Timeout...like Unix.select *) + timeout:float -> + (* The callback for file system events *) + (event list -> unit) -> + unit +end + +type t = { + aaaaaaaaa : aaaa; + bbbbbbbbb : bbbb; +} + +type trace_mod_funs = { + trace_mod : bool option; + trace_funs : bool Map.M(String).t; +} + +let x { aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa } = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb = bbb bb bbbbbb } + +let x + { + aaaaaaaaaaaaaaaaaaaaaa; + aaaaaaaaaaaaaaaaaaa; + aaaaaaaaaaaaaa; + aaaaaaaaaaaaaaaaaa; + aaaaaaaaaa; + } = + { + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; + bbbbbbbbbbbbb = bbb bb bbbbbb; + cccccc = cccc ccccccccccccccccccccccc; + } + +(* this is an array *) +let length = + [| + 0; + 269999999999999999999999999999999999999999999999999; + 26; + (* foo *) 27 (* foo *); + 27; + 27; + |] + [@foo] + +(* this is a list *) +let length = + [ + 0; + 14; + (* foo *) + 14; + 17 (* foo *); + 17; + 2777777777777777777777777777777777; + 27; + ] + [@foo] +;; + +Fooooooo.foo ~foooooooooooooo ~fooooooooo:"" + (Foo.foo ~foo ~foo ~foooo:() + [ + ("fooooo", Foo.fooo ~foooo ~foooo:(foooo >*> fooooo)); + ("foooo", fooooooo); + ("foooooo", foooooooo); + ("fooooooooo", foooooooo); + ]) + +class + [ 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, + 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ] + x = + [ 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, + 'yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy ] + k + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ( 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, + 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ) + e + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ('aaaaaaaaa, 'bbbbbbbbbbbb) e + +let ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, + yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy, + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz, + (aaaaaaaaaaaa, bbbbbbbbbbbb) ) = + ( ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, + yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy, + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz ), + (aaaaaaaaaaaaaa, bbbbbbbbbbbb) ) + +type t = aaaaaaaaaaaa -> bbbbbbbbbbbb -> cccccccccc + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb -> + ccccccccccccccccccccccccc + +type t = + (* foooooooooooo *) + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + (* foooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb -> + (* fooooooooooooooooo *) + ccccccccccccccccccccccccc -> + (* foooooo *) + foo * [ `Foo of foo * foo ] -> + (* foooooooooooooooo *) + foo + * foo + * foo + * foo + * [ `Foo of + (* fooooooooooooooooooo *) + foo * foo * foo -> + foo -> + foo -> + (* foooooooooooo *) + foo -> + foo -> + foo * foo -> + foo * foo -> + foo * foo + ] -> + (* foooooooooooooooo *) + fooooooooooooooooo + +type t = { + (* fooooooooooooooooo *) + foo : foo; + (* foooooooooooooooooooooo fooooooooooooooooooo fooooooooooooooo + foooooooooooooooooo foooooooooooooooo *) + foo : + (* fooooooooooooooooooo *) + foooooooooooo -> + (* foooooooooooooo *) + foooooooooooooooo -> + foooooooooooooo -> + foooooooooo -> + fooooooooooooooo; + foo : foo; +} + +[@@@ocamlformat "ocp-indent-compat"] + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb -> + ccccccccccccccccccccccccc + +type t = + (string Location.loc * payload) list -> + (string Location.loc * bool) list option + * (string Location.loc * payload) list -> + (string Location.loc * bool) list option + * (string Location.loc * payload) list -> + (string Location.loc * bool) list option + * (string Location.loc * payload) list + +let x { aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa } = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb = bbb bb bbbbbb } + +let x + { + aaaaaaaaaaaaaaaaaaaaaa; + aaaaaaaaaaaaaaaaaaa; + aaaaaaaaaaaaaa; + aaaaaaaaaaaaaaaaaa; + aaaaaaaaaa; + } + = + { + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; + bbbbbbbbbbbbb = bbb bb bbbbbb; + cccccc = cccc ccccccccccccccccccccccc; + } + +let foooooooooooooooooooooooooooooooooo = + { + (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; + (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + bbbbbbbbbbbbb = bbb bb bbbbbb; + cccccc = cccc ccccccccccccccccccccccc; + } + +let foooooooooooo = + { + foooooooooooooo with + fooooooooooooooooooooooooooooo = fooooooooooooo; + fooooooooooooo = foooooooooooooo; + } + +let foooooooooooo = + { + foooooooooooooo with + (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo + *) + fooooooooooooooooooooooooooooo = fooooooooooooo; + fooooooooooooo = foooooooooooooo; + } + +let fooooooooooo = function + | Pmty_alias lid -> + { + empty with + bdy = fmt_longident_loc c lid; + epi = Some (fmt_attributes c ~key:"@" pmty_attributes ~pre:(fmt "@ ")); + } + +let f () = + let { + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + } + = + some_value + in + foooooooooooo + +let f () = + let [ + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + ] + = + some_value + in + foooooooooooo + +let f () = + let [| + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + |] + = + some_value + in + foooooooooooo + +let g () = + match some_value with + | { + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + } -> + foooooooo + | [ + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + ] -> + fooooooooo + | [| + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + |] -> + fooooooooo + +let () = + match x with + | ( _, + (* line 1 line 2 *) + Some _ ) -> + x + +let () = + match x with + | ( _, + (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1 + veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 + *) + Some _ ) -> + x diff --git a/test/passing/refs.default/break_separators-before_docked.ml.ref b/test/passing/refs.default/break_separators-before_docked.ml.ref new file mode 100644 index 0000000000..5dd7d8d091 --- /dev/null +++ b/test/passing/refs.default/break_separators-before_docked.ml.ref @@ -0,0 +1,434 @@ +type t = { + (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooo : foooooooooooooooooooooooooooooooooooooooo + ; (* foooooooooooooooooooooooooooooooooooooooooooo *) + fooooooooooooooooooooooooooooo : fooooooooooooooooooooooooooo +} + +type x = + | B of { + (* fooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaa + ; (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbbbbb + } + +type t = { + aaaaaaaaaaaaaaaaaaaaaaaaa : aaaa aaaaaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbb bbbb + ; cccccccccccccccccccccc : ccccccc ccccccccccc cccccccc +} + +type x = + | B of { + aaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbbbbb + } + +type t = { + break_cases : [ `Fit | `Nested | `All ] + ; break_collection_expressions : [ `Wrap | `Fit_or_vertical ] + ; break_infix : [ `Wrap | `Fit_or_vertical ] + ; break_separators : bool + ; break_sequences : bool + ; break_string_literals : [ `Newlines | `Never | `Wrap ] + (** How to potentially break string literals into new lines. *) + ; break_struct : bool + ; cases_exp_indent : int + ; comment_check : bool + ; disable : bool + ; doc_comments : [ `Before | `After ] + ; escape_chars : [ `Decimal | `Hexadecimal | `Preserve ] + (** Escape encoding for chars literals. *) + ; escape_strings : [ `Decimal | `Hexadecimal | `Preserve ] + (** Escape encoding for string literals. *) + ; extension_sugar : [ `Preserve | `Always ] + ; field_space : [ `Tight | `Loose ] + ; if_then_else : [ `Compact | `Keyword_first ] + ; indicate_multiline_delimiters : bool + ; indicate_nested_or_patterns : bool + ; infix_precedence : [ `Indent | `Parens ] + ; leading_nested_match_parens : bool + ; let_and : [ `Compact | `Sparse ] + ; let_binding_spacing : [ `Compact | `Sparse | `Double_semicolon ] + ; let_open : [ `Preserve | `Auto | `Short | `Long ] + ; margin : int (** Format code to fit within [margin] columns. *) + ; max_iters : int + (** Fail if output of formatting does not stabilize within [max_iters] + iterations. *) + ; module_item_spacing : [ `Compact | `Sparse ] + ; ocp_indent_compat : bool (** Try to indent like ocp-indent *) + ; parens_ite : bool + ; parens_tuple : [ `Always | `Multi_line_only ] + ; parens_tuple_patterns : [ `Always | `Multi_line_only ] + ; parse_docstrings : bool + ; quiet : bool + ; sequence_style : [ `Separator | `Terminator ] + ; single_case : [ `Compact | `Sparse ] + ; type_decl : [ `Compact | `Sparse ] + ; wrap_comments : bool (** Wrap comments at margin. *) + ; wrap_fun_args : bool +} + +let _ = + match something with + | { + very_very_long_field_name_running_out_of_space = 1 + ; another_very_very_long_field_name_running_out_of_space = 2 + ; _ + } -> + 0 + | _ -> 1 + +let _ = + match something with + | [ + very_very_long_field_name_running_out_of_space + ; another_very_very_long_field_name_running_out_of_space + ; _ + ] -> + 0 + | _ -> 1 + +let _ = + match something with + | [| + very_very_long_field_name_running_out_of_space + ; another_very_very_long_field_name_running_out_of_space + ; _ + |] -> + 0 + | _ -> 1 + +[@@@ocamlformat "type-decl=compact"] + +type t = { aaaaaaaaa : aaaa; bbbbbbbbb : bbbb } + +type trace_mod_funs = { + trace_mod : bool option + ; trace_funs : bool Map.M(String).t +} + +[@@@ocamlformat "type-decl=sparse"] + +module X = struct + val select : + (* The fsevents context *) + env + -> (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list + -> (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list + -> (* Timeout...like Unix.select *) + timeout:float + -> (* The callback for file system events *) + (event list -> unit) + -> unit +end + +type t = { + aaaaaaaaa : aaaa + ; bbbbbbbbb : bbbb +} + +type trace_mod_funs = { + trace_mod : bool option + ; trace_funs : bool Map.M(String).t +} + +let x { aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa } = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb = bbb bb bbbbbb } + +let x + { + aaaaaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaa + ; aaaaaaaaaa + } = + { + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbb = bbb bb bbbbbb + ; cccccc = cccc ccccccccccccccccccccccc + } + +(* this is an array *) +let length = + [| + 0 + ; 269999999999999999999999999999999999999999999999999 + ; 26 + ; (* foo *) 27 (* foo *) + ; 27 + ; 27 + |] + [@foo] + +(* this is a list *) +let length = + [ + 0 + ; 14 + ; (* foo *) + 14 + ; 17 (* foo *) + ; 17 + ; 2777777777777777777777777777777777 + ; 27 + ] + [@foo] +;; + +Fooooooo.foo ~foooooooooooooo ~fooooooooo:"" + (Foo.foo ~foo ~foo ~foooo:() + [ + ("fooooo", Foo.fooo ~foooo ~foooo:(foooo >*> fooooo)) + ; ("foooo", fooooooo) + ; ("foooooo", foooooooo) + ; ("fooooooooo", foooooooo) + ]) + +class + [ 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + , 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ] + x = + [ 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + , 'yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy ] + k + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ( 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + , 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ) + e + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ('aaaaaaaaa, 'bbbbbbbbbbbb) e + +let ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + , yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy + , zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + , (aaaaaaaaaaaa, bbbbbbbbbbbb) ) = + ( ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + , yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy + , zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz ) + , (aaaaaaaaaaaaaa, bbbbbbbbbbbb) ) + +type t = aaaaaaaaaaaa -> bbbbbbbbbbbb -> cccccccccc + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + -> ccccccccccccccccccccccccc + +type t = + (* foooooooooooo *) + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + -> (* foooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + -> (* fooooooooooooooooo *) + ccccccccccccccccccccccccc + -> (* foooooo *) + foo * [ `Foo of foo * foo ] + -> (* foooooooooooooooo *) + foo + * foo + * foo + * foo + * [ `Foo of + (* fooooooooooooooooooo *) + foo * foo * foo + -> foo + -> foo + -> (* foooooooooooo *) + foo + -> foo + -> foo * foo + -> foo * foo + -> foo * foo + ] + -> (* foooooooooooooooo *) + fooooooooooooooooo + +type t = { + (* fooooooooooooooooo *) + foo : foo + ; (* foooooooooooooooooooooo fooooooooooooooooooo fooooooooooooooo + foooooooooooooooooo foooooooooooooooo *) + foo : + (* fooooooooooooooooooo *) + foooooooooooo + -> (* foooooooooooooo *) + foooooooooooooooo + -> foooooooooooooo + -> foooooooooo + -> fooooooooooooooo + ; foo : foo +} + +[@@@ocamlformat "ocp-indent-compat"] + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + -> ccccccccccccccccccccccccc + +type t = + (string Location.loc * payload) list + -> (string Location.loc * bool) list option + * (string Location.loc * payload) list + -> (string Location.loc * bool) list option + * (string Location.loc * payload) list + -> (string Location.loc * bool) list option + * (string Location.loc * payload) list + +let x { aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa } = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb = bbb bb bbbbbb } + +let x + { + aaaaaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaa + ; aaaaaaaaaa + } + = + { + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbb = bbb bb bbbbbb + ; cccccc = cccc ccccccccccccccccccccccc + } + +let foooooooooooooooooooooooooooooooooo = + { + (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa + ; (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + bbbbbbbbbbbbb = bbb bb bbbbbb + ; cccccc = cccc ccccccccccccccccccccccc + } + +let foooooooooooo = + { + foooooooooooooo with + fooooooooooooooooooooooooooooo = fooooooooooooo + ; fooooooooooooo = foooooooooooooo + } + +let foooooooooooo = + { + foooooooooooooo with + (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo + *) + fooooooooooooooooooooooooooooo = fooooooooooooo + ; fooooooooooooo = foooooooooooooo + } + +let fooooooooooo = function + | Pmty_alias lid -> + { + empty with + bdy = fmt_longident_loc c lid + ; epi = Some (fmt_attributes c ~key:"@" pmty_attributes ~pre:(fmt "@ ")) + } + +let f () = + let { + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + } + = + some_value + in + foooooooooooo + +let f () = + let [ + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + ] + = + some_value + in + foooooooooooo + +let f () = + let [| + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + |] + = + some_value + in + foooooooooooo + +let g () = + match some_value with + | { + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + } -> + foooooooo + | [ + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + ] -> + fooooooooo + | [| + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + |] -> + fooooooooo + +let () = + match x with + | ( _ + , (* line 1 line 2 *) + Some _ ) -> + x + +let () = + match x with + | ( _ + , (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1 + veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 + *) + Some _ ) -> + x diff --git a/test/passing/refs.default/break_separators.ml.ref b/test/passing/refs.default/break_separators.ml.ref new file mode 100644 index 0000000000..5dd7d8d091 --- /dev/null +++ b/test/passing/refs.default/break_separators.ml.ref @@ -0,0 +1,434 @@ +type t = { + (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooo : foooooooooooooooooooooooooooooooooooooooo + ; (* foooooooooooooooooooooooooooooooooooooooooooo *) + fooooooooooooooooooooooooooooo : fooooooooooooooooooooooooooo +} + +type x = + | B of { + (* fooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaa + ; (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbbbbb + } + +type t = { + aaaaaaaaaaaaaaaaaaaaaaaaa : aaaa aaaaaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbb bbbb + ; cccccccccccccccccccccc : ccccccc ccccccccccc cccccccc +} + +type x = + | B of { + aaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbbbbb + } + +type t = { + break_cases : [ `Fit | `Nested | `All ] + ; break_collection_expressions : [ `Wrap | `Fit_or_vertical ] + ; break_infix : [ `Wrap | `Fit_or_vertical ] + ; break_separators : bool + ; break_sequences : bool + ; break_string_literals : [ `Newlines | `Never | `Wrap ] + (** How to potentially break string literals into new lines. *) + ; break_struct : bool + ; cases_exp_indent : int + ; comment_check : bool + ; disable : bool + ; doc_comments : [ `Before | `After ] + ; escape_chars : [ `Decimal | `Hexadecimal | `Preserve ] + (** Escape encoding for chars literals. *) + ; escape_strings : [ `Decimal | `Hexadecimal | `Preserve ] + (** Escape encoding for string literals. *) + ; extension_sugar : [ `Preserve | `Always ] + ; field_space : [ `Tight | `Loose ] + ; if_then_else : [ `Compact | `Keyword_first ] + ; indicate_multiline_delimiters : bool + ; indicate_nested_or_patterns : bool + ; infix_precedence : [ `Indent | `Parens ] + ; leading_nested_match_parens : bool + ; let_and : [ `Compact | `Sparse ] + ; let_binding_spacing : [ `Compact | `Sparse | `Double_semicolon ] + ; let_open : [ `Preserve | `Auto | `Short | `Long ] + ; margin : int (** Format code to fit within [margin] columns. *) + ; max_iters : int + (** Fail if output of formatting does not stabilize within [max_iters] + iterations. *) + ; module_item_spacing : [ `Compact | `Sparse ] + ; ocp_indent_compat : bool (** Try to indent like ocp-indent *) + ; parens_ite : bool + ; parens_tuple : [ `Always | `Multi_line_only ] + ; parens_tuple_patterns : [ `Always | `Multi_line_only ] + ; parse_docstrings : bool + ; quiet : bool + ; sequence_style : [ `Separator | `Terminator ] + ; single_case : [ `Compact | `Sparse ] + ; type_decl : [ `Compact | `Sparse ] + ; wrap_comments : bool (** Wrap comments at margin. *) + ; wrap_fun_args : bool +} + +let _ = + match something with + | { + very_very_long_field_name_running_out_of_space = 1 + ; another_very_very_long_field_name_running_out_of_space = 2 + ; _ + } -> + 0 + | _ -> 1 + +let _ = + match something with + | [ + very_very_long_field_name_running_out_of_space + ; another_very_very_long_field_name_running_out_of_space + ; _ + ] -> + 0 + | _ -> 1 + +let _ = + match something with + | [| + very_very_long_field_name_running_out_of_space + ; another_very_very_long_field_name_running_out_of_space + ; _ + |] -> + 0 + | _ -> 1 + +[@@@ocamlformat "type-decl=compact"] + +type t = { aaaaaaaaa : aaaa; bbbbbbbbb : bbbb } + +type trace_mod_funs = { + trace_mod : bool option + ; trace_funs : bool Map.M(String).t +} + +[@@@ocamlformat "type-decl=sparse"] + +module X = struct + val select : + (* The fsevents context *) + env + -> (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list + -> (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list + -> (* Timeout...like Unix.select *) + timeout:float + -> (* The callback for file system events *) + (event list -> unit) + -> unit +end + +type t = { + aaaaaaaaa : aaaa + ; bbbbbbbbb : bbbb +} + +type trace_mod_funs = { + trace_mod : bool option + ; trace_funs : bool Map.M(String).t +} + +let x { aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa } = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb = bbb bb bbbbbb } + +let x + { + aaaaaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaa + ; aaaaaaaaaa + } = + { + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbb = bbb bb bbbbbb + ; cccccc = cccc ccccccccccccccccccccccc + } + +(* this is an array *) +let length = + [| + 0 + ; 269999999999999999999999999999999999999999999999999 + ; 26 + ; (* foo *) 27 (* foo *) + ; 27 + ; 27 + |] + [@foo] + +(* this is a list *) +let length = + [ + 0 + ; 14 + ; (* foo *) + 14 + ; 17 (* foo *) + ; 17 + ; 2777777777777777777777777777777777 + ; 27 + ] + [@foo] +;; + +Fooooooo.foo ~foooooooooooooo ~fooooooooo:"" + (Foo.foo ~foo ~foo ~foooo:() + [ + ("fooooo", Foo.fooo ~foooo ~foooo:(foooo >*> fooooo)) + ; ("foooo", fooooooo) + ; ("foooooo", foooooooo) + ; ("fooooooooo", foooooooo) + ]) + +class + [ 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + , 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ] + x = + [ 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + , 'yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy ] + k + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ( 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + , 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ) + e + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ('aaaaaaaaa, 'bbbbbbbbbbbb) e + +let ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + , yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy + , zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + , (aaaaaaaaaaaa, bbbbbbbbbbbb) ) = + ( ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + , yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy + , zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz ) + , (aaaaaaaaaaaaaa, bbbbbbbbbbbb) ) + +type t = aaaaaaaaaaaa -> bbbbbbbbbbbb -> cccccccccc + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + -> ccccccccccccccccccccccccc + +type t = + (* foooooooooooo *) + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + -> (* foooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + -> (* fooooooooooooooooo *) + ccccccccccccccccccccccccc + -> (* foooooo *) + foo * [ `Foo of foo * foo ] + -> (* foooooooooooooooo *) + foo + * foo + * foo + * foo + * [ `Foo of + (* fooooooooooooooooooo *) + foo * foo * foo + -> foo + -> foo + -> (* foooooooooooo *) + foo + -> foo + -> foo * foo + -> foo * foo + -> foo * foo + ] + -> (* foooooooooooooooo *) + fooooooooooooooooo + +type t = { + (* fooooooooooooooooo *) + foo : foo + ; (* foooooooooooooooooooooo fooooooooooooooooooo fooooooooooooooo + foooooooooooooooooo foooooooooooooooo *) + foo : + (* fooooooooooooooooooo *) + foooooooooooo + -> (* foooooooooooooo *) + foooooooooooooooo + -> foooooooooooooo + -> foooooooooo + -> fooooooooooooooo + ; foo : foo +} + +[@@@ocamlformat "ocp-indent-compat"] + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + -> ccccccccccccccccccccccccc + +type t = + (string Location.loc * payload) list + -> (string Location.loc * bool) list option + * (string Location.loc * payload) list + -> (string Location.loc * bool) list option + * (string Location.loc * payload) list + -> (string Location.loc * bool) list option + * (string Location.loc * payload) list + +let x { aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa } = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb = bbb bb bbbbbb } + +let x + { + aaaaaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaa + ; aaaaaaaaaa + } + = + { + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbb = bbb bb bbbbbb + ; cccccc = cccc ccccccccccccccccccccccc + } + +let foooooooooooooooooooooooooooooooooo = + { + (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa + ; (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + bbbbbbbbbbbbb = bbb bb bbbbbb + ; cccccc = cccc ccccccccccccccccccccccc + } + +let foooooooooooo = + { + foooooooooooooo with + fooooooooooooooooooooooooooooo = fooooooooooooo + ; fooooooooooooo = foooooooooooooo + } + +let foooooooooooo = + { + foooooooooooooo with + (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo + *) + fooooooooooooooooooooooooooooo = fooooooooooooo + ; fooooooooooooo = foooooooooooooo + } + +let fooooooooooo = function + | Pmty_alias lid -> + { + empty with + bdy = fmt_longident_loc c lid + ; epi = Some (fmt_attributes c ~key:"@" pmty_attributes ~pre:(fmt "@ ")) + } + +let f () = + let { + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + } + = + some_value + in + foooooooooooo + +let f () = + let [ + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + ] + = + some_value + in + foooooooooooo + +let f () = + let [| + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + |] + = + some_value + in + foooooooooooo + +let g () = + match some_value with + | { + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + } -> + foooooooo + | [ + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + ] -> + fooooooooo + | [| + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + |] -> + fooooooooo + +let () = + match x with + | ( _ + , (* line 1 line 2 *) + Some _ ) -> + x + +let () = + match x with + | ( _ + , (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1 + veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 + *) + Some _ ) -> + x diff --git a/test/passing/refs.default/break_sequence_before.ml.ref b/test/passing/refs.default/break_sequence_before.ml.ref new file mode 100644 index 0000000000..7103bc64b4 --- /dev/null +++ b/test/passing/refs.default/break_sequence_before.ml.ref @@ -0,0 +1,47 @@ +[@@@ocamlformat "sequence-style=before"] + +let foo x y = + lazy + (fooooooooooooooooooooooo + ; fooooooooooooooooooooooo + ;%ext + foooooooooooooooooooooooooo + ; fooooooooooooooooooooooooo) + +let _ = + do_ + ;%ext + job_1 + ; job_2 + ; job_1 + ; job_2 + ; job_1 + ;%ext + job_2 + ; job_1 + ; job_2 + ; job_1 + ; job_2 + ; return () + +let _ = + do_ + ; job_1 + ; job_2 + ;%ext + f + (job_1 + ; job_2 + ; job_1 + ; job_2 + ; job_1 + ;%ext + job_2 + ;%ext + job_2 + ; job_1 + ; job_2 + ; job_1 + ; job_2) + ;%ext + return () diff --git a/test/passing/refs.default/break_string_literals-never.ml.err b/test/passing/refs.default/break_string_literals-never.ml.err new file mode 100644 index 0000000000..0ab87f371a --- /dev/null +++ b/test/passing/refs.default/break_string_literals-never.ml.err @@ -0,0 +1,6 @@ +Warning: break_string_literals-never.ml:3 exceeds the margin +Warning: break_string_literals-never.ml:6 exceeds the margin +Warning: break_string_literals-never.ml:31 exceeds the margin +Warning: break_string_literals-never.ml:34 exceeds the margin +Warning: break_string_literals-never.ml:43 exceeds the margin +Warning: break_string_literals-never.ml:48 exceeds the margin diff --git a/test/passing/refs.default/break_string_literals-never.ml.ref b/test/passing/refs.default/break_string_literals-never.ml.ref new file mode 100644 index 0000000000..27cd085ae3 --- /dev/null +++ b/test/passing/refs.default/break_string_literals-never.ml.ref @@ -0,0 +1,50 @@ +let () = + if true then (* Shrinking the margin a bit *) + Format.printf + "@[@{@{Warning@}@}@,@,\ These are @{<warning>NOT@} the Droids you are looking for!@,@,\ Some more text. Just more letters and words.@,\ All this text is left-aligned because it's part of the UI.@,\ It'll be easier for the user to read this message.@]@\n@." + +let fooooooo = + "@\n\n\ [Perf Profiler Log] Function: '%s' @\n\ count trace id = %i @\n\ sum inclusive cpu time = %f@\n\ avg inclusive time = %f @\n\ sum exclusive cpu time = %f @\n\ avg exclusive_time = %f @\n\ inclusive p90 = %f @\n\ exclusive p90 = %f @\n\ inclusive p50 = %f @\n\ exclusive p50 = %f @\n\ inclusive p25 = %f @\n\ exclusive p25 = %f @\n" + +let foooo = + Printf.sprintf + "%s\nUsage: infer %s [options]\nSee `infer%s --help` for more information." + +let pp_sep fmt () = F.fprintf fmt ", @,\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n\n\n" +let pp_sep fmt () = F.fprintf fmt ", @,@\n" +let pp_sep fmt () = F.fprintf fmt ", @,@\n@\n" +let pp_sep fmt () = F.fprintf fmt ", @,@\n@\n@\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n\n@\n\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n@;@\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n\n@,@\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n\n@\n\n" +let fooooooooo = Fooooo "[%a]\n" +let fooooooooo = Fooooo "[%a]@\n" +let fooooooooo = Fooooo "[%a]\n@\n" +let fooooooooo = Fooooo "[%a]@\n\n" +let fooo = Fooo "@\nFooooo: `%s`\n" + +let fooooooooooo = + "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum." + +let fooooooooooo = + "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.@;Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat.@;Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur.@;Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum." + +let _ = "abc@,def\n\nghi" +let _ = "abc@,def\n\n ghi" +let _ = "abc@,def\n\n" +let _ = "abc@,def@\n\n" + +let _ = + Pp.textf + "Failed to parse environment variable: %s=%s\nPermitted values: if-exists always never\nDefault: %s" + var v (to_string default) + +let _ = + Pp.textf + "Failed to parse environment variable: %s=%s Permitted values: if-exists always never Default: %s" + var v (to_string default) diff --git a/test/passing/refs.default/break_string_literals.ml.ref b/test/passing/refs.default/break_string_literals.ml.ref new file mode 100644 index 0000000000..3566cc2b9d --- /dev/null +++ b/test/passing/refs.default/break_string_literals.ml.ref @@ -0,0 +1,85 @@ +let () = + if true then (* Shrinking the margin a bit *) + Format.printf + "@[<v 2>@{<warning>@{<title>Warning@}@}@,\ + @,\ + \ These are @{<warning>NOT@} the Droids you are looking for!@,\ + @,\ + \ Some more text. Just more letters and words.@,\ + \ All this text is left-aligned because it's part of the UI.@,\ + \ It'll be easier for the user to read this message.@]@\n\ + @." + +let fooooooo = + "@\n\n\ + \ [Perf Profiler Log] Function: '%s' @\n\ + \ count trace id = %i @\n\ + \ sum inclusive cpu time = %f@\n\ + \ avg inclusive time = %f @\n\ + \ sum exclusive cpu time = %f @\n\ + \ avg exclusive_time = %f @\n\ + \ inclusive p90 = %f @\n\ + \ exclusive p90 = %f @\n\ + \ inclusive p50 = %f @\n\ + \ exclusive p50 = %f @\n\ + \ inclusive p25 = %f @\n\ + \ exclusive p25 = %f @\n" + +let foooo = + Printf.sprintf + "%s\nUsage: infer %s [options]\nSee `infer%s --help` for more information." + +let pp_sep fmt () = F.fprintf fmt ", @,\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n\n\n" +let pp_sep fmt () = F.fprintf fmt ", @,@\n" +let pp_sep fmt () = F.fprintf fmt ", @,@\n@\n" +let pp_sep fmt () = F.fprintf fmt ", @,@\n@\n@\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n\n@\n\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n@;@\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n\n@,@\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n\n@\n\n" +let fooooooooo = Fooooo "[%a]\n" +let fooooooooo = Fooooo "[%a]@\n" +let fooooooooo = Fooooo "[%a]\n@\n" +let fooooooooo = Fooooo "[%a]@\n\n" +let fooo = Fooo "@\nFooooo: `%s`\n" + +let fooooooooooo = + "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod \ + tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim \ + veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea \ + commodo consequat. Duis aute irure dolor in reprehenderit in voluptate \ + velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat \ + cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id \ + est laborum." + +let fooooooooooo = + "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod \ + tempor incididunt ut labore et dolore magna aliqua.@;\ + Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut \ + aliquip ex ea commodo consequat.@;\ + Duis aute irure dolor in reprehenderit in voluptate velit esse cillum \ + dolore eu fugiat nulla pariatur.@;\ + Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia \ + deserunt mollit anim id est laborum." + +let _ = "abc@,def\n\nghi" +let _ = "abc@,def\n\n ghi" +let _ = "abc@,def\n\n" +let _ = "abc@,def@\n\n" + +let _ = + Pp.textf + "Failed to parse environment variable: %s=%s\n\ + Permitted values: if-exists always never\n\ + Default: %s" + var v (to_string default) + +let _ = + Pp.textf + "Failed to parse environment variable: %s=%s Permitted values: if-exists \ + always never Default: %s" + var v (to_string default) diff --git a/test/passing/refs.default/break_struct.ml.ref b/test/passing/refs.default/break_struct.ml.ref new file mode 100644 index 0000000000..3e7d393d84 --- /dev/null +++ b/test/passing/refs.default/break_struct.ml.ref @@ -0,0 +1,77 @@ +[@@@ocamlformat "break-struct=natural"] + +module M = X (Y) (struct let x = k end) + +module Hash = struct + include Hash + + module type S = S.HASH +end + +module Hash = struct + include Hash + include Hash + + module type S = S.HASH + module type S = S.HASH +end + +module Hash = struct + include Hash + include Hash + include Hash + + module type S = S.HASH + module type S = S.HASH + module type S = S.HASH +end + +module Hash = struct + let z = + zzzzzzzzzzzzzzzzzzzzzz zzzzzzzzzzzzzzzzzzzzzz zzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzz zzzzzzzzzzzzzzzzzz zzzzzzzzzzzzzzzz zzzzzzzzzz + + let z = + zzzzzzzzzzzzzz zzzzzzzzzzzzzzz zzzzzzzzzzzzzzz zzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzz zzzzzzzzzzzzzzzzzz zzzzzzzzzzzzzzzzzz + + include Hash + + module type S = S.HASH +end + +module Vector = struct + include Vector + + let pp sep pp_elt fs v = List.pp sep pp_elt fs (to_list v) +end + +module Hash = struct + include Hash + include Hash + + module type S = S.HASH + module type S = S.HASH +end + +module M = struct include A end +module M = struct include A include B end +module M = struct include A include B include C end +module M = struct include A include B include C include D end + +module M = struct + include A + include B + include C + include D + + let x = xxxxxxxxxxx xxxxxxxxxxxxx + let z = zzzzzzzzzzzzz +end + +include ( + Ast_407 : + module type of struct + include Ast_407 + end + with module Location := Ast_407.Location) diff --git a/test/passing/refs.default/cases_exp_grouping.ml.ref b/test/passing/refs.default/cases_exp_grouping.ml.ref new file mode 100644 index 0000000000..659b545fc5 --- /dev/null +++ b/test/passing/refs.default/cases_exp_grouping.ml.ref @@ -0,0 +1,93 @@ +let _ = + match x with + | A -> begin match B with A -> fooooooooooooo end + | A -> begin match B with A -> fooooooooooooo | B -> fooooooooooooo end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + | C -> fooooooooooooo + | D -> fooooooooooooo + end +[@@ocamlformat "break-cases=fit"] + +let _ = + match x with + | A -> begin + match B with A -> fooooooooooooo + end + | A -> begin + match B with A -> fooooooooooooo | B -> fooooooooooooo + end + | A -> begin + match B with + | A -> + fooooooooooooo + | B -> + fooooooooooooo + | C -> + fooooooooooooo + | D -> + fooooooooooooo + end +[@@ocamlformat "break-cases=nested"] + +let _ = + match x with + | A -> begin + match B with + | A -> fooooooooooooo + end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + | C -> fooooooooooooo + | D -> fooooooooooooo + end +[@@ocamlformat "break-cases=toplevel"] + +let _ = + match x with + | A -> begin + match B with + | A -> fooooooooooooo + end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + | C -> fooooooooooooo + | D -> fooooooooooooo + end +[@@ocamlformat "break-cases=fit-or-vertical"] + +let _ = + match x with + | A -> begin + match B with + | A -> fooooooooooooo + end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + | C -> fooooooooooooo + | D -> fooooooooooooo + end +[@@ocamlformat "break-cases=all"] diff --git a/test/passing/refs.default/cinaps.ml.ref b/test/passing/refs.default/cinaps.ml.ref new file mode 100644 index 0000000000..f6b4897bc2 --- /dev/null +++ b/test/passing/refs.default/cinaps.ml.ref @@ -0,0 +1,74 @@ +(*$ + for i = 1 to 3 do + Printf.printf "let x%d = %d\n" i i + done +$*) +let x1 = 1 + +(*$*) + +let x = 1 + +(*$ + print_newline (); + List.iter + (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s) + [ "+"; "-"; "*"; "/" ] +*) + +(*$*) +let y = 2 + +(*$ + #use "import.cinaps";; + + List.iter all_fields ~f:(fun (name, type_) -> + printf "\nexternal get_%s\n : unit -> %s = \"get_%s\"" name type_ name) +*) +external get_name : unit -> string = "get_name" + +(*$*) + +let x = 1 + +(*$ + let x = 1 in + (* fooooooo *) + let y = 2 in + (* foooooooo *) + z +$*) + +(*$*) + +let foo = foo + +(*$QR foo Q.small_int (fun i-> foo i (+) [1;2;3] = List.fold_left (+) i + [1;2;3] ) *) +let foo = foo + +(* Cinaps comment should not wrap if they don't parse. The first one would + crash and the second become a mess *) + +(*$(**)" + "*) + +(*$ + print_newline () ; + <SYNTAX ERROR> + List.iter + (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s) + ["+"; "-"; "*"; "/"] +*) + +(*$*) + +(*$ (* + x + *) *) + +(*$*) + +(*$ let _ = [ x (* *); y ] *) + +(*$*) diff --git a/test/passing/refs.default/class_expr.ml.err b/test/passing/refs.default/class_expr.ml.err new file mode 100644 index 0000000000..ba51e1bdbe --- /dev/null +++ b/test/passing/refs.default/class_expr.ml.err @@ -0,0 +1 @@ +Warning: class_expr.ml:9 exceeds the margin diff --git a/test/passing/refs.default/class_expr.ml.ref b/test/passing/refs.default/class_expr.ml.ref new file mode 100644 index 0000000000..18f88d89ba --- /dev/null +++ b/test/passing/refs.default/class_expr.ml.ref @@ -0,0 +1,19 @@ +class c (`I i) = x +class c `I = x +class c i = x +class c (* xx *) i (* yy *) = x + +class c = + object + method class_infos : 'a. ('a -> 'res) -> 'a class_infos -> 'res = + fun _a + { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } -> + let pci_virt = self#virtual_flag pci_virt in + let pci_params = self#list in + () + end + +class c = + (let () = print_endline "Class init" in + with_param) + () diff --git a/test/passing/refs.default/class_sig-after.mli.ref b/test/passing/refs.default/class_sig-after.mli.ref new file mode 100644 index 0000000000..7ed2e66b19 --- /dev/null +++ b/test/passing/refs.default/class_sig-after.mli.ref @@ -0,0 +1,37 @@ +class c : 'a -> object + val x : 'b +end + +(** Fitting *) + +class c : object end +class c : int -> object end +class c : int -> object end[@attr] +class c : int -> object end [@@attr] +class c : int -> object end +class c (* a *) : (* b *) int (* c *) -> (* d *) object (* e *) end (* f *) +class c : object end + +class c : object + (** Standalone doc-string. *) +end + +class unix_mockup : + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> + bar + +class unix_mockup : + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> +object + method foo : string +end diff --git a/test/passing/refs.default/class_sig.mli.ref b/test/passing/refs.default/class_sig.mli.ref new file mode 100644 index 0000000000..7ed2e66b19 --- /dev/null +++ b/test/passing/refs.default/class_sig.mli.ref @@ -0,0 +1,37 @@ +class c : 'a -> object + val x : 'b +end + +(** Fitting *) + +class c : object end +class c : int -> object end +class c : int -> object end[@attr] +class c : int -> object end [@@attr] +class c : int -> object end +class c (* a *) : (* b *) int (* c *) -> (* d *) object (* e *) end (* f *) +class c : object end + +class c : object + (** Standalone doc-string. *) +end + +class unix_mockup : + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> + bar + +class unix_mockup : + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> +object + method foo : string +end diff --git a/test/passing/refs.default/class_type.ml.ref b/test/passing/refs.default/class_type.ml.ref new file mode 100644 index 0000000000..c40d66c070 --- /dev/null +++ b/test/passing/refs.default/class_type.ml.ref @@ -0,0 +1,15 @@ +class c : x -> y -> z = object end + +class c : + (* fooooooooooooo foooooooooo *) xxxxxxxxxxxxxx -> + (* fooooooooo foooooooooo *) yyyyyyyyyyyyyy -> + (* fooooooooooooo fooooooooooo *) zzzzzzzzzzzzzzzzzz = object end + +class c : + (* fooooooooooooo foooooooooo *) xxxxxxxxxxxxxx (* fooooooooooo *) -> + (* fooooooooo foooooooooo *) yyyyyyyyyyyyyy (* foooooooooooooo *) -> + (* fooooooooooooo fooooooooooo *) zzzzzzzzzzzzzzzzzz (* fooooooooooooooooo *) + = object end + +class c : (a -> b) -> x = object end +class c : x -> (a -> b) -> y = object end diff --git a/test/passing/refs.default/cmdline_override.ml.ref b/test/passing/refs.default/cmdline_override.ml.ref new file mode 100644 index 0000000000..b098640eef --- /dev/null +++ b/test/passing/refs.default/cmdline_override.ml.ref @@ -0,0 +1,3 @@ +let x = 1 + +let y = 2 diff --git a/test/passing/refs.default/cmdline_override2.ml.ref b/test/passing/refs.default/cmdline_override2.ml.ref new file mode 100644 index 0000000000..b098640eef --- /dev/null +++ b/test/passing/refs.default/cmdline_override2.ml.ref @@ -0,0 +1,3 @@ +let x = 1 + +let y = 2 diff --git a/test/passing/refs.default/coerce.ml.ref b/test/passing/refs.default/coerce.ml.ref new file mode 100644 index 0000000000..9e21c1755c --- /dev/null +++ b/test/passing/refs.default/coerce.ml.ref @@ -0,0 +1,24 @@ +let _ = + let a :> x = v in + let a : x :> y = v in + let a = (v :> x) in + let a = (v : x :> y) in + let a : x :> y = (v : x :> y) in + () + +let a :> x = v +let a : x :> y = v +let a = (v :> x) +let a = (v : x :> y) +let a : x :> y = (v : x :> y) + +class c = + let a :> x = v in + let a : x :> y = v in + let a = (v :> x) in + let a = (v : x :> y) in + let a : x :> y = (v : x :> y) in + object end + +let f (type a) :> a M.u = function z -> z +let f x (type a) :> a M.u = function z -> z diff --git a/test/passing/refs.default/comment_breaking.ml.ref b/test/passing/refs.default/comment_breaking.ml.ref new file mode 100644 index 0000000000..46b92b0b5d --- /dev/null +++ b/test/passing/refs.default/comment_breaking.ml.ref @@ -0,0 +1,8 @@ +let () = + foo aaaaaaaaaa bbbbbbbbbb cccccccccc |> (ignore : t -> _); + bar dddddddddd eeeeeeeeee ffffffffff |> (ignore : t -> _) + +let () = + (* this comment should not change breaking of the following line *) + foo aaaaaaaaaa bbbbbbbbbb cccccccccc |> (ignore : t -> _); + bar dddddddddd eeeeeeeeee ffffffffff |> (ignore : t -> _) diff --git a/test/passing/tests/comment_header.ml.ref b/test/passing/refs.default/comment_header.ml.ref similarity index 98% rename from test/passing/tests/comment_header.ml.ref rename to test/passing/refs.default/comment_header.ml.ref index 6940cb8125..4005932ee5 100644 --- a/test/passing/tests/comment_header.ml.ref +++ b/test/passing/refs.default/comment_header.ml.ref @@ -43,7 +43,9 @@ type typ = typ (* xx xxxxxxxxxxxxxx, x xxxxxxxxxxxxxx "xxxxxxxxx" xxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxx xxxxx. *) -(* TEST arguments = "???" *) +(* TEST + arguments = "???" + *) (* On Windows the runtime expand windows wildcards (asterisks and * question marks). diff --git a/test/passing/refs.default/comment_in_empty.ml.ref b/test/passing/refs.default/comment_in_empty.ml.ref new file mode 100644 index 0000000000..4521a4ff2c --- /dev/null +++ b/test/passing/refs.default/comment_in_empty.ml.ref @@ -0,0 +1,43 @@ +module M = struct + (* this module is empty *) +end + +module type M = sig + (* this module type is empty *) +end + +class type m = object end (* this class type is empty *) + +let x = object (* this object is empty *) end +let _ = [ (* this list is empty *) ] +let _ = (* this list is empty2 *) [] +let _ = (* this list is empty2 *) [] +let _ = [| (* this array is empty *) |] +let _ = f ( (* comment in unit *) ) +let _ = f "asd" (* te""st *) 3 + +let x = function + | [ (* empty list pat *) ] + | [| (* empty array pat *) |] + | ( (* unit pat *) ) + | "" (* comment *) -> + () + +let x = + object + method x () = {< (* this override is empty *) >} + end + +type t = private [> (*this variant is empty *) ] +type t = < (* this object type is empty *) > +type t = < .. (* this object type is empty *) > + +let x = + ( (* Lorem ipsum dolor sit amet, consectetur adipiscing elit. Sed non + risus. Suspendisse lectus tortor, dignissim sit amet, adipiscing nec, + ultricies sed, dolor. *) ) + +let x = + [ (* Lorem ipsum dolor sit amet, consectetur adipiscing elit. Sed non + risus. Suspendisse lectus tortor, dignissim sit amet, adipiscing nec, + ultricies sed, dolor. *) ] diff --git a/test/passing/refs.default/comment_in_modules.ml.ref b/test/passing/refs.default/comment_in_modules.ml.ref new file mode 100644 index 0000000000..cf0cd74d55 --- /dev/null +++ b/test/passing/refs.default/comment_in_modules.ml.ref @@ -0,0 +1,32 @@ +module M = struct + (* comments *) +end + +module M : sig + (* comments *) +end = struct + (* comments *) +end + +module type M = sig + (* comments *) +end + +module Mmmmmmmmmmmmmmmmmmmmmm = Aaaaaaaaaaaaaaaaaaaaaa.Bbbbbbbbbbbbbbbbbbbbbbbb +(** Xxxxxxx xxxxxxxx xx xxxxxxx xxxxxxxxxxxxx xxxxxxxxx xx xxxx *) + +(** Xxxxxxx xxxxxxxx xx xxxxxxx xxxxxxxxxxxxx xxxxxxxxx xx xxxx *) +module Fffffffffffffff (Yyyyyyyyyyyyyyy : Z.S) = + Gggggggggg (Wwwwwwwwww.Make (Yyyyyyyyyy)) + +module A (* comment *) (A : sig end) : sig end = struct end +module A (A : sig end) (* comment *) (B : sig end) : sig end = struct end +module A (A : sig end) : sig end = (* comment *) struct end +module (* comment *) A (A : sig end) : sig end = struct end + +module rec A : A = struct end + +(** floatting *) + +and B : B = struct end +(** about b *) diff --git a/test/passing/refs.default/comment_last.ml.ref b/test/passing/refs.default/comment_last.ml.ref new file mode 100644 index 0000000000..2006814fe3 --- /dev/null +++ b/test/passing/refs.default/comment_last.ml.ref @@ -0,0 +1,4 @@ +let x = 2 +let y = 3 + +(*comment*) diff --git a/test/passing/refs.default/comment_sparse.ml.ref b/test/passing/refs.default/comment_sparse.ml.ref new file mode 100644 index 0000000000..da0b12b351 --- /dev/null +++ b/test/passing/refs.default/comment_sparse.ml.ref @@ -0,0 +1,10 @@ +[@@@ocamlformat "break-cases=nested"] + +let f x = + match x with + | `A -> + () + | `B -> + (* Proin ipsum nunc, finibus et finibus, semper et mi. Aenean *) + (* pretium fermentum tellus, a faucibus sagittis et. Cras non *) + () diff --git a/test/passing/refs.default/comments-no-wrap.ml.err b/test/passing/refs.default/comments-no-wrap.ml.err new file mode 100644 index 0000000000..0bb572e41e --- /dev/null +++ b/test/passing/refs.default/comments-no-wrap.ml.err @@ -0,0 +1,3 @@ +Warning: comments-no-wrap.ml:167 exceeds the margin +Warning: comments-no-wrap.ml:229 exceeds the margin +Warning: comments-no-wrap.ml:378 exceeds the margin diff --git a/test/passing/refs.default/comments-no-wrap.ml.ref b/test/passing/refs.default/comments-no-wrap.ml.ref new file mode 100644 index 0000000000..f8c7a2eacc --- /dev/null +++ b/test/passing/refs.default/comments-no-wrap.ml.ref @@ -0,0 +1,434 @@ +(* *) + +(**) + +(* *) + +(*$*) +(*$ *) +(*$ *) + +let _ = f (*f*) a (*a*) ~b (*comment*) ~c:(*comment*) c' ?d ?e () + +let _ = + let _ = + f + (*comment*) + (let open M in + let x = x in + e) + in + () + +let _ = ((*comment*) a (*comment*), b) +let foo = function Blah ((* old *) x, y) -> () +let foo = function Blah (x (* old *), y) -> () +let foo = function Blah, (* old *) (x, y) -> () +let foo = function Blah (x, y) (* old *) -> () +let foo = function Blah, (x, y (* old *)) -> () +let foo = function Blah, (x, (* old *) y) -> () +let foo = function (x, y) (* old *), z -> () +let _ = if (* a0 *) b (* c0 *) then (* d0 *) e (* f0 *) else (* g0 *) h (* i0 *) +let _ = if (* a1 *) b (* c1 *) then (* d1 *) e (* f1 *) else (* g1 *) h (* i1 *) +let _ = if (* a2 *) B (* c2 *) then (* d2 *) E (* f2 *) else (* g2 *) H (* i2 *) +let _ = if (* a3 *) B (* c3 *) then (* d3 *) E (* f3 *) else (* g3 *) H (* i3 *) +;; + +match x with +| true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" +| false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +(* this comment should not change the formatting of the following case *) +| false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +;; + +try f x +with +(* this comment is intended to refer to the entire case below *) +| Caml.Not_found -> + () +;; + +match x with +(* this comment is intended to refer to the entire case below *) +| false -> () +;; + +match x with +| Aaaaaaaaaaaaaaaaaaaa +(* this comment is intended to refer to the case below *) +| Bbbbbbbbbbbbbbbbbbbb -> + () + +let _ = + (* this comment is intended to refer to the entire match below *) + match x with + | "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" -> () + | "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" -> () + +module type M = sig + val f (* A list of [name], [count] pairs. *) : (string * int) list -> int +end + +let _ = f ~f:(fun a b -> c) (* comment *) ~f:(fun a b -> c) +let _ = f (fun x -> g h) (* comment *) ~f:(fun a b -> c) +let _ = f (g h) (* comment *) ~f:(fun a b -> c) +let _ = f (0 + 0 (* test *) + (1 * 1) (* test *)) +let _ = f ((1 * 1) (* test *) + (0 + 0) (* test *)) +let _ = match e with 3 (* test *) -> e | 3 (* test *) :: tail -> e +let _ = if a then b :: c (* d *) else e +let (b :: c (* d *)) = x + +module rec A = struct end + +(*test*) +and B = struct end + +module type T = sig + module rec A : sig end + + (*test*) + and B : sig end +end + +let f = (* comment *) function x -> x +let foo x = (* comment *) (y : z) + +let _ = + (*a*) + s (*b*).((*c*) + (*d*) + i + (*e*)) + +let _ = + (*a*) + s (*b*).((*c*) + (*d*) + i + (*e*)) <- + (*f*) + (*g*) + x + +let _ = + (*a*) + s (*b*).[(*c*) + (*d*) + i + (*e*)] + +let _ = + (*a*) + s (*b*).[(*c*) + (*d*) + i + (*e*)] <- + (*f*) + (*g*) + x + +let _ = + (*a*) + s (*b*).{(*c*) + (*d*) + i + (*e*)} + +let _ = + (*a*) + s (*b*).{(*c*) + (*d*) + i + (*e*)} <- + (*f*) + (*g*) + x + +let _ = (*a*) s (*b*).%{(*c*) i (*d*)} + +let _ = + (*a*) + s (*b*).%{(*c*) i (*d*)} <- + (*e*) + (*f*) + x + +type t = { a : int; [@default a] (* comment *) b : flag } + +let () = + (* *) + + (* *) + () + +(* break when unicode sequence length measured in bytes but ¬ in code points *) + +type t = + | Aaaaaaaaaa + (* Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. *) + | Bbbbbbbbbb (* foo *) + | Bbbbbbbbbb (* foo *) + +let () = + xxxxxxxxxx + || + (* xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + +let () = + xxxxxxxxxx + land + (* xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + +let rec fooooooooooo = function + (*XX*) + | x :: t (*YY*) -> k + (* AA*) + | [ + (*BB*) + (* CC *) + x + (* DD *); + (* EE *) + y + (* FF *) + (* GG *); + ] + (* HH *) -> + k + (* AA*) + (*BB*) + (* CC *) + | x (* DD *) :: (* EE *) t + (* FF *) + (* GG *) + (* HH *) -> + k + (* AA*) + (*BB*) + (* CC *) + | x + (* DD *) + (* XX *) + :: (* YY *) + (* EE *) t + (* FF *) + (* GG *) + (* HH *) -> + k + (* AA *) + (* BB *) + | (module (* CC *) + (* DD *) F (* EE *) : (* FF *) M (* GG *)) (* HH *) + :: (* II *) t + (* JJ *) + (* KK *) -> + foo + +let%map + (* __________________________________________________________________________________________ *) + _ = + () + +type t = + < (* a *) + a : int [@atr] (* b *) + ; b : int + (* c *) > + +type t = < a : int (* a *) ; (* b *) .. (* c *) > +type t = < (* a *) .. (* b *) > + +class type i = object + (* test *) + inherit oo +end + +class i = + object + (* test *) + inherit oo + end + +let _ = + try_with (fun () -> + (* comment before *) + match get () with + | None -> do_something () + | Some _ -> () (* do nothing *)) + +let _ = + try_with (fun () -> + (* comment before *) + a; + b (* after b *)) + +let _ = + match x with + | Some y -> ( match y with None -> () | Some z -> incr z (* double some *)) + | None -> () + +type prefix = { + sib_extend : int; (** add more as needed *) (* extended sib index bit *) +} + +type t = + | A (* A *) + (* | B *) + | C + +type t = + (* | B *) + | A (* A *) + | C + +type t = + | A + (* A *) + (* | B *) + | C + +type foo = Alpha | Beta [@@ocaml.warning "-37" (* Explanation of warning *)] + +type foo = + | Alpha______________________________ + | Beta_______________________________ +[@@ocaml.warning "-37" (* Explanation of warning *)] + +let y = + f + (* a *) + (* b *) + x + +module A (* A *) () (* B *) = (* C *) B + +let kk = (* foo *) (module A : T) +let kk = (* foo *) (module A : T) +let kk = (module A : T) (* foo *) +let kk = (* foo *) (module A : T) (* foo *) + +let kk = + (* before exp *) + (* before exp_pack *) + (module (* before A *) A (* after A *)) +(* after exp_pack *) +(* after exp *) + +let kk = + (* before exp *) + (* before exp_pack *) + (module (* before A *) A (* after A *) : (* before S *) S (* after S *)) +(* after exp_pack *) +(* after exp *) + +let _ = assert (foo (bar + baz <= quux)) +(* this comment should stay attached to the preceding item *) + +let _ = foo + +let a = + [ + b; + (* *) + (* c *) + ] + +let _ = + 1 + + + (* foooooooooooooooooooooooo fooooooooooooooo fooooooooooooooooo *) + fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + - + (* fooooooooooooo foooooooooooooooooooooo foooooooooooooooooooo *) + foooooooooooooo foooooooooooooo foooooooooooooooooo fooooooooo + % + (* foooooooooooooooo foooooooooooo foooooooooooooooooo *) + fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + / + (* foooooooooooooooooooooooo fooooooooooooooo fooooooooooooooooo *) + barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr + * + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + $ + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + & + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + = + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + > + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + < + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + @ foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + ^ + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + || + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo + fooooooooooooooo#= + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo + foooooooooooooooo fooooooooooooooo + +let _ = + ! + (*a*) + (*b*) + x + +let _ = + (*x*) + ! + (*a*) + (*b*) + x (*c*) y + +let _ = + f + ((*x*) + ! + (*a*) + (*b*) + x + (*c*) y) + y + +type a = b (* a *) as (* b *) 'c (* c *) + +type t = { + (* comment before mutable *) + mutable + (* really long comment that doesn't fit on the same line as other stuff *) + x : + int; +} + +let _ = (x + y) [@attr] + z +let _ = x ^ (y ^ z) [@attr] + +let _ = + (); + (* indentation preserved + *) + (); + (* indentation preserved + *) + (); + (* indentation preserved + *) + (); + (* indentation not preserved +*) + () + +let vexpr (*aa*) (type (*bb*) a) (*cc*) (type (*dd*) b) (*ee*) : _ -> _ = k diff --git a/test/passing/refs.default/comments.ml.err b/test/passing/refs.default/comments.ml.err new file mode 100644 index 0000000000..1d173a9c51 --- /dev/null +++ b/test/passing/refs.default/comments.ml.err @@ -0,0 +1,3 @@ +Warning: comments.ml:167 exceeds the margin +Warning: comments.ml:229 exceeds the margin +Warning: comments.ml:378 exceeds the margin diff --git a/test/passing/refs.default/comments.ml.ref b/test/passing/refs.default/comments.ml.ref new file mode 100644 index 0000000000..f8c7a2eacc --- /dev/null +++ b/test/passing/refs.default/comments.ml.ref @@ -0,0 +1,434 @@ +(* *) + +(**) + +(* *) + +(*$*) +(*$ *) +(*$ *) + +let _ = f (*f*) a (*a*) ~b (*comment*) ~c:(*comment*) c' ?d ?e () + +let _ = + let _ = + f + (*comment*) + (let open M in + let x = x in + e) + in + () + +let _ = ((*comment*) a (*comment*), b) +let foo = function Blah ((* old *) x, y) -> () +let foo = function Blah (x (* old *), y) -> () +let foo = function Blah, (* old *) (x, y) -> () +let foo = function Blah (x, y) (* old *) -> () +let foo = function Blah, (x, y (* old *)) -> () +let foo = function Blah, (x, (* old *) y) -> () +let foo = function (x, y) (* old *), z -> () +let _ = if (* a0 *) b (* c0 *) then (* d0 *) e (* f0 *) else (* g0 *) h (* i0 *) +let _ = if (* a1 *) b (* c1 *) then (* d1 *) e (* f1 *) else (* g1 *) h (* i1 *) +let _ = if (* a2 *) B (* c2 *) then (* d2 *) E (* f2 *) else (* g2 *) H (* i2 *) +let _ = if (* a3 *) B (* c3 *) then (* d3 *) E (* f3 *) else (* g3 *) H (* i3 *) +;; + +match x with +| true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" +| false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +(* this comment should not change the formatting of the following case *) +| false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +;; + +try f x +with +(* this comment is intended to refer to the entire case below *) +| Caml.Not_found -> + () +;; + +match x with +(* this comment is intended to refer to the entire case below *) +| false -> () +;; + +match x with +| Aaaaaaaaaaaaaaaaaaaa +(* this comment is intended to refer to the case below *) +| Bbbbbbbbbbbbbbbbbbbb -> + () + +let _ = + (* this comment is intended to refer to the entire match below *) + match x with + | "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" -> () + | "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" -> () + +module type M = sig + val f (* A list of [name], [count] pairs. *) : (string * int) list -> int +end + +let _ = f ~f:(fun a b -> c) (* comment *) ~f:(fun a b -> c) +let _ = f (fun x -> g h) (* comment *) ~f:(fun a b -> c) +let _ = f (g h) (* comment *) ~f:(fun a b -> c) +let _ = f (0 + 0 (* test *) + (1 * 1) (* test *)) +let _ = f ((1 * 1) (* test *) + (0 + 0) (* test *)) +let _ = match e with 3 (* test *) -> e | 3 (* test *) :: tail -> e +let _ = if a then b :: c (* d *) else e +let (b :: c (* d *)) = x + +module rec A = struct end + +(*test*) +and B = struct end + +module type T = sig + module rec A : sig end + + (*test*) + and B : sig end +end + +let f = (* comment *) function x -> x +let foo x = (* comment *) (y : z) + +let _ = + (*a*) + s (*b*).((*c*) + (*d*) + i + (*e*)) + +let _ = + (*a*) + s (*b*).((*c*) + (*d*) + i + (*e*)) <- + (*f*) + (*g*) + x + +let _ = + (*a*) + s (*b*).[(*c*) + (*d*) + i + (*e*)] + +let _ = + (*a*) + s (*b*).[(*c*) + (*d*) + i + (*e*)] <- + (*f*) + (*g*) + x + +let _ = + (*a*) + s (*b*).{(*c*) + (*d*) + i + (*e*)} + +let _ = + (*a*) + s (*b*).{(*c*) + (*d*) + i + (*e*)} <- + (*f*) + (*g*) + x + +let _ = (*a*) s (*b*).%{(*c*) i (*d*)} + +let _ = + (*a*) + s (*b*).%{(*c*) i (*d*)} <- + (*e*) + (*f*) + x + +type t = { a : int; [@default a] (* comment *) b : flag } + +let () = + (* *) + + (* *) + () + +(* break when unicode sequence length measured in bytes but ¬ in code points *) + +type t = + | Aaaaaaaaaa + (* Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. *) + | Bbbbbbbbbb (* foo *) + | Bbbbbbbbbb (* foo *) + +let () = + xxxxxxxxxx + || + (* xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + +let () = + xxxxxxxxxx + land + (* xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + +let rec fooooooooooo = function + (*XX*) + | x :: t (*YY*) -> k + (* AA*) + | [ + (*BB*) + (* CC *) + x + (* DD *); + (* EE *) + y + (* FF *) + (* GG *); + ] + (* HH *) -> + k + (* AA*) + (*BB*) + (* CC *) + | x (* DD *) :: (* EE *) t + (* FF *) + (* GG *) + (* HH *) -> + k + (* AA*) + (*BB*) + (* CC *) + | x + (* DD *) + (* XX *) + :: (* YY *) + (* EE *) t + (* FF *) + (* GG *) + (* HH *) -> + k + (* AA *) + (* BB *) + | (module (* CC *) + (* DD *) F (* EE *) : (* FF *) M (* GG *)) (* HH *) + :: (* II *) t + (* JJ *) + (* KK *) -> + foo + +let%map + (* __________________________________________________________________________________________ *) + _ = + () + +type t = + < (* a *) + a : int [@atr] (* b *) + ; b : int + (* c *) > + +type t = < a : int (* a *) ; (* b *) .. (* c *) > +type t = < (* a *) .. (* b *) > + +class type i = object + (* test *) + inherit oo +end + +class i = + object + (* test *) + inherit oo + end + +let _ = + try_with (fun () -> + (* comment before *) + match get () with + | None -> do_something () + | Some _ -> () (* do nothing *)) + +let _ = + try_with (fun () -> + (* comment before *) + a; + b (* after b *)) + +let _ = + match x with + | Some y -> ( match y with None -> () | Some z -> incr z (* double some *)) + | None -> () + +type prefix = { + sib_extend : int; (** add more as needed *) (* extended sib index bit *) +} + +type t = + | A (* A *) + (* | B *) + | C + +type t = + (* | B *) + | A (* A *) + | C + +type t = + | A + (* A *) + (* | B *) + | C + +type foo = Alpha | Beta [@@ocaml.warning "-37" (* Explanation of warning *)] + +type foo = + | Alpha______________________________ + | Beta_______________________________ +[@@ocaml.warning "-37" (* Explanation of warning *)] + +let y = + f + (* a *) + (* b *) + x + +module A (* A *) () (* B *) = (* C *) B + +let kk = (* foo *) (module A : T) +let kk = (* foo *) (module A : T) +let kk = (module A : T) (* foo *) +let kk = (* foo *) (module A : T) (* foo *) + +let kk = + (* before exp *) + (* before exp_pack *) + (module (* before A *) A (* after A *)) +(* after exp_pack *) +(* after exp *) + +let kk = + (* before exp *) + (* before exp_pack *) + (module (* before A *) A (* after A *) : (* before S *) S (* after S *)) +(* after exp_pack *) +(* after exp *) + +let _ = assert (foo (bar + baz <= quux)) +(* this comment should stay attached to the preceding item *) + +let _ = foo + +let a = + [ + b; + (* *) + (* c *) + ] + +let _ = + 1 + + + (* foooooooooooooooooooooooo fooooooooooooooo fooooooooooooooooo *) + fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + - + (* fooooooooooooo foooooooooooooooooooooo foooooooooooooooooooo *) + foooooooooooooo foooooooooooooo foooooooooooooooooo fooooooooo + % + (* foooooooooooooooo foooooooooooo foooooooooooooooooo *) + fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + / + (* foooooooooooooooooooooooo fooooooooooooooo fooooooooooooooooo *) + barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr + * + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + $ + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + & + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + = + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + > + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + < + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + @ foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + ^ + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + || + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo + fooooooooooooooo#= + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo + foooooooooooooooo fooooooooooooooo + +let _ = + ! + (*a*) + (*b*) + x + +let _ = + (*x*) + ! + (*a*) + (*b*) + x (*c*) y + +let _ = + f + ((*x*) + ! + (*a*) + (*b*) + x + (*c*) y) + y + +type a = b (* a *) as (* b *) 'c (* c *) + +type t = { + (* comment before mutable *) + mutable + (* really long comment that doesn't fit on the same line as other stuff *) + x : + int; +} + +let _ = (x + y) [@attr] + z +let _ = x ^ (y ^ z) [@attr] + +let _ = + (); + (* indentation preserved + *) + (); + (* indentation preserved + *) + (); + (* indentation preserved + *) + (); + (* indentation not preserved +*) + () + +let vexpr (*aa*) (type (*bb*) a) (*cc*) (type (*dd*) b) (*ee*) : _ -> _ = k diff --git a/test/passing/refs.default/comments.mli.ref b/test/passing/refs.default/comments.mli.ref new file mode 100644 index 0000000000..0624bb388c --- /dev/null +++ b/test/passing/refs.default/comments.mli.ref @@ -0,0 +1,7 @@ +val f : unit +(** docstring *) +(* comment *) + +val g : unit +(** docstring *) +(* comment *) diff --git a/test/passing/tests/comments_args.ml.ref b/test/passing/refs.default/comments_args.ml.ref similarity index 100% rename from test/passing/tests/comments_args.ml.ref rename to test/passing/refs.default/comments_args.ml.ref diff --git a/test/passing/tests/comments_around_disabled.ml.ref b/test/passing/refs.default/comments_around_disabled.ml.ref similarity index 100% rename from test/passing/tests/comments_around_disabled.ml.ref rename to test/passing/refs.default/comments_around_disabled.ml.ref diff --git a/test/passing/refs.default/comments_in_local_let.ml.ref b/test/passing/refs.default/comments_in_local_let.ml.ref new file mode 100644 index 0000000000..319bbeede4 --- /dev/null +++ b/test/passing/refs.default/comments_in_local_let.ml.ref @@ -0,0 +1,11 @@ +let _ = + (* a *) + let _ = + (* b *) + foo + (* c *) + (* d *) + in + (* e *) + () +(* f *) diff --git a/test/passing/refs.default/comments_in_record-break_separator-after.ml.err b/test/passing/refs.default/comments_in_record-break_separator-after.ml.err new file mode 100644 index 0000000000..7187312046 --- /dev/null +++ b/test/passing/refs.default/comments_in_record-break_separator-after.ml.err @@ -0,0 +1,3 @@ +Warning: comments_in_record-break_separator-after.ml:25 exceeds the margin +Warning: comments_in_record-break_separator-after.ml:46 exceeds the margin +Warning: comments_in_record-break_separator-after.ml:48 exceeds the margin diff --git a/test/passing/refs.default/comments_in_record-break_separator-after.ml.ref b/test/passing/refs.default/comments_in_record-break_separator-after.ml.ref new file mode 100644 index 0000000000..b011463882 --- /dev/null +++ b/test/passing/refs.default/comments_in_record-break_separator-after.ml.ref @@ -0,0 +1,134 @@ +type t = { + a : int; (* some comment *) + b : float; + c : string; + d : [ `something_looooooooooooooooooooooooooooooooong ]; +} + +type t = { + a : int; (** some comment *) + b : float; + c : string; + d : [ `something_looooooooooooooooooooooooooooooooong ]; +} + +type t = { a : int; (* Comment *) b : int (* Comment *) } + +type t = { + a : int; (* Comment *) + b : int; (* Comment *) +} +[@@ocamlformat "type-decl=sparse"] + +let { + (* cmts *) + pat; + loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong; + a; + (* b *) b; + (* c *) c; + d = + (* d *) + (D : loooooooooooooooooooooooooooooooooooooooooooooooooooooooong_int); + (* e *) + e : loooooooooooooooooooooooooooooooooooooooooooooooooooooooong_int; + } = + exp + +let x = + { + (* Xxxx xxxxxxxx xxxxx xx xx xx xxxx xxxxxx - XXxx_xxxxx xxx'x. *) + Irure_sed_a.in_nisi_sed = Irure_sed_fugiat.LaboRum sint_sed; + in_ea_deserunt = nulla; + } + +type t = { + a : int option; + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) + b : float; + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) +} + +type t = + | Tuple of { elts : t vector; packed : bool } + | Struct of { + name : string; + elts : t vector (* possibly cyclic, name unique *); + [@compare.ignore] [@equal.ignore] [@sexp_drop_if fun _ -> true] + elts : t vector; + (* possibly cyclic, name unique *) + (* mooooooooooooooooooooooooooooooooooore comments *) + [@compare.ignore] + [@equal.ignore] + [@sexp_drop_if fun _ -> true] + packed : bool; + } + | Opaque of { name : string } +[@@deriving compare, equal, hash, sexp] + +type t = { (* c *) c (* c' *) : (* d *) d (* d' *) } + +let _ = + { + (* a *) a (* a' *) = (* b *) b (* b' *); + (* c *) c (* c' *) : (* d *) d (* d' *) = (* e *) e (* e' *); + (* f *) f (* f' *); + (* g *) g (* g' *) = + (* j *) ((* h *) h (* h' *) : (* i *) i (* i' *)) (* j' *); + } + +let { + (* a *) a (* a' *) = (* b *) b (* b' *); + (* c *) c (* c' *) : (* d *) d (* d' *) = (* e *) e (* e' *); + (* f *) f (* f' *); + (* g *) g (* g' *) = + (* j *) ((* h *) h (* h' *) : (* i *) i (* i' *)) (* j' *); + } = + x + +type program = { + prog_globals : global list; (* global variables *) + prog_struct_types : lltype list; (* data structures *) + prog_lib_funcs : func list; (* library functions *) +} + +type t = { + mutable ci_fixed : IntervalSet.t; + mutable ci_spilled : + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) + IntervalSet.t; +} + +type t = { + mutable ci_fixed : IntervalSet.t; + mutable + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) + ci_spilled : + IntervalSet.t; +} + +type t = { + mutable ci_fixed : IntervalSet.t; + mutable ci_spilled + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) : + IntervalSet.t; +} + +let _ = + match c with + | { + issuer = _; + (* TODO *) + _; + } -> + () + | { issuer = _; (* TODO *) _ } -> () + | { issuer = _; _ (* TODO *) } -> () + | { + issuer = _; + (* TODO *) + _ + (* TODO *); + } -> + () + | { issuer = _; (* TODO *) _ (* TODO *) } -> () diff --git a/test/passing/refs.default/comments_in_record-break_separator-before.ml.err b/test/passing/refs.default/comments_in_record-break_separator-before.ml.err new file mode 100644 index 0000000000..d7b192906c --- /dev/null +++ b/test/passing/refs.default/comments_in_record-break_separator-before.ml.err @@ -0,0 +1,3 @@ +Warning: comments_in_record-break_separator-before.ml:25 exceeds the margin +Warning: comments_in_record-break_separator-before.ml:46 exceeds the margin +Warning: comments_in_record-break_separator-before.ml:48 exceeds the margin diff --git a/test/passing/refs.default/comments_in_record-break_separator-before.ml.ref b/test/passing/refs.default/comments_in_record-break_separator-before.ml.ref new file mode 100644 index 0000000000..4642e03a40 --- /dev/null +++ b/test/passing/refs.default/comments_in_record-break_separator-before.ml.ref @@ -0,0 +1,134 @@ +type t = { + a : int (* some comment *) + ; b : float + ; c : string + ; d : [ `something_looooooooooooooooooooooooooooooooong ] +} + +type t = { + a : int (** some comment *) + ; b : float + ; c : string + ; d : [ `something_looooooooooooooooooooooooooooooooong ] +} + +type t = { a : int (* Comment *); b : int (* Comment *) } + +type t = { + a : int (* Comment *) + ; b : int (* Comment *) +} +[@@ocamlformat "type-decl=sparse"] + +let { + (* cmts *) + pat + ; loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong + ; a + ; (* b *) b + ; (* c *) c + ; d = + (* d *) + (D : loooooooooooooooooooooooooooooooooooooooooooooooooooooooong_int) + ; (* e *) + e : loooooooooooooooooooooooooooooooooooooooooooooooooooooooong_int + } = + exp + +let x = + { + (* Xxxx xxxxxxxx xxxxx xx xx xx xxxx xxxxxx - XXxx_xxxxx xxx'x. *) + Irure_sed_a.in_nisi_sed = Irure_sed_fugiat.LaboRum sint_sed + ; in_ea_deserunt = nulla + } + +type t = { + a : int option + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) + ; b : float + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) +} + +type t = + | Tuple of { elts : t vector; packed : bool } + | Struct of { + name : string + ; elts : t vector (* possibly cyclic, name unique *) + [@compare.ignore] [@equal.ignore] [@sexp_drop_if fun _ -> true] + ; elts : t vector + (* possibly cyclic, name unique *) + (* mooooooooooooooooooooooooooooooooooore comments *) + [@compare.ignore] + [@equal.ignore] + [@sexp_drop_if fun _ -> true] + ; packed : bool + } + | Opaque of { name : string } +[@@deriving compare, equal, hash, sexp] + +type t = { (* c *) c (* c' *) : (* d *) d (* d' *) } + +let _ = + { + (* a *) a (* a' *) = (* b *) b (* b' *) + ; (* c *) c (* c' *) : (* d *) d (* d' *) = (* e *) e (* e' *) + ; (* f *) f (* f' *) + ; (* g *) g (* g' *) = + (* j *) ((* h *) h (* h' *) : (* i *) i (* i' *)) (* j' *) + } + +let { + (* a *) a (* a' *) = (* b *) b (* b' *) + ; (* c *) c (* c' *) : (* d *) d (* d' *) = (* e *) e (* e' *) + ; (* f *) f (* f' *) + ; (* g *) g (* g' *) = + (* j *) ((* h *) h (* h' *) : (* i *) i (* i' *)) (* j' *) + } = + x + +type program = { + prog_globals : global list (* global variables *) + ; prog_struct_types : lltype list (* data structures *) + ; prog_lib_funcs : func list (* library functions *) +} + +type t = { + mutable ci_fixed : IntervalSet.t + ; mutable ci_spilled : + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) + IntervalSet.t +} + +type t = { + mutable ci_fixed : IntervalSet.t + ; mutable + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) + ci_spilled : + IntervalSet.t +} + +type t = { + mutable ci_fixed : IntervalSet.t + ; mutable ci_spilled + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) : + IntervalSet.t +} + +let _ = + match c with + | { + issuer = _ + ; (* TODO *) + _ + } -> + () + | { issuer = _; (* TODO *) _ } -> () + | { issuer = _; _ (* TODO *) } -> () + | { + issuer = _ + ; (* TODO *) + _ + (* TODO *) + } -> + () + | { issuer = _; (* TODO *) _ (* TODO *) } -> () diff --git a/test/passing/refs.default/comments_in_record.ml.err b/test/passing/refs.default/comments_in_record.ml.err new file mode 100644 index 0000000000..8ca2c301e3 --- /dev/null +++ b/test/passing/refs.default/comments_in_record.ml.err @@ -0,0 +1,3 @@ +Warning: comments_in_record.ml:25 exceeds the margin +Warning: comments_in_record.ml:46 exceeds the margin +Warning: comments_in_record.ml:48 exceeds the margin diff --git a/test/passing/refs.default/comments_in_record.ml.ref b/test/passing/refs.default/comments_in_record.ml.ref new file mode 100644 index 0000000000..b011463882 --- /dev/null +++ b/test/passing/refs.default/comments_in_record.ml.ref @@ -0,0 +1,134 @@ +type t = { + a : int; (* some comment *) + b : float; + c : string; + d : [ `something_looooooooooooooooooooooooooooooooong ]; +} + +type t = { + a : int; (** some comment *) + b : float; + c : string; + d : [ `something_looooooooooooooooooooooooooooooooong ]; +} + +type t = { a : int; (* Comment *) b : int (* Comment *) } + +type t = { + a : int; (* Comment *) + b : int; (* Comment *) +} +[@@ocamlformat "type-decl=sparse"] + +let { + (* cmts *) + pat; + loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong; + a; + (* b *) b; + (* c *) c; + d = + (* d *) + (D : loooooooooooooooooooooooooooooooooooooooooooooooooooooooong_int); + (* e *) + e : loooooooooooooooooooooooooooooooooooooooooooooooooooooooong_int; + } = + exp + +let x = + { + (* Xxxx xxxxxxxx xxxxx xx xx xx xxxx xxxxxx - XXxx_xxxxx xxx'x. *) + Irure_sed_a.in_nisi_sed = Irure_sed_fugiat.LaboRum sint_sed; + in_ea_deserunt = nulla; + } + +type t = { + a : int option; + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) + b : float; + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) +} + +type t = + | Tuple of { elts : t vector; packed : bool } + | Struct of { + name : string; + elts : t vector (* possibly cyclic, name unique *); + [@compare.ignore] [@equal.ignore] [@sexp_drop_if fun _ -> true] + elts : t vector; + (* possibly cyclic, name unique *) + (* mooooooooooooooooooooooooooooooooooore comments *) + [@compare.ignore] + [@equal.ignore] + [@sexp_drop_if fun _ -> true] + packed : bool; + } + | Opaque of { name : string } +[@@deriving compare, equal, hash, sexp] + +type t = { (* c *) c (* c' *) : (* d *) d (* d' *) } + +let _ = + { + (* a *) a (* a' *) = (* b *) b (* b' *); + (* c *) c (* c' *) : (* d *) d (* d' *) = (* e *) e (* e' *); + (* f *) f (* f' *); + (* g *) g (* g' *) = + (* j *) ((* h *) h (* h' *) : (* i *) i (* i' *)) (* j' *); + } + +let { + (* a *) a (* a' *) = (* b *) b (* b' *); + (* c *) c (* c' *) : (* d *) d (* d' *) = (* e *) e (* e' *); + (* f *) f (* f' *); + (* g *) g (* g' *) = + (* j *) ((* h *) h (* h' *) : (* i *) i (* i' *)) (* j' *); + } = + x + +type program = { + prog_globals : global list; (* global variables *) + prog_struct_types : lltype list; (* data structures *) + prog_lib_funcs : func list; (* library functions *) +} + +type t = { + mutable ci_fixed : IntervalSet.t; + mutable ci_spilled : + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) + IntervalSet.t; +} + +type t = { + mutable ci_fixed : IntervalSet.t; + mutable + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) + ci_spilled : + IntervalSet.t; +} + +type t = { + mutable ci_fixed : IntervalSet.t; + mutable ci_spilled + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) : + IntervalSet.t; +} + +let _ = + match c with + | { + issuer = _; + (* TODO *) + _; + } -> + () + | { issuer = _; (* TODO *) _ } -> () + | { issuer = _; _ (* TODO *) } -> () + | { + issuer = _; + (* TODO *) + _ + (* TODO *); + } -> + () + | { issuer = _; (* TODO *) _ (* TODO *) } -> () diff --git a/test/passing/refs.default/crlf_to_crlf.ml.ref b/test/passing/refs.default/crlf_to_crlf.ml.ref new file mode 100644 index 0000000000..e25842ec4d --- /dev/null +++ b/test/passing/refs.default/crlf_to_crlf.ml.ref @@ -0,0 +1,41 @@ +let _ = {| +foo + + bar +|} + +(** This is verbatim: + + {v + o o + /\ /\ + /\ /\ + v} + + This is preformated code: + + {[ + let verbatim s = + s |> String.split_lines |> List.map ~f:String.strip |> fun s -> + list s "@," Fmt.str + ]} *) + +(** Lists: + + list with short lines: + + - x + + list with long lines: + + - xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx + xxx xxx xxx xxx xxx xxx + + list with sub lists: + + {ul + {- xxx + + - a + } + } *) diff --git a/test/passing/refs.default/crlf_to_lf.ml.ref b/test/passing/refs.default/crlf_to_lf.ml.ref new file mode 100644 index 0000000000..c1ab159dd5 --- /dev/null +++ b/test/passing/refs.default/crlf_to_lf.ml.ref @@ -0,0 +1,41 @@ +let _ = {| +foo + + bar +|} + +(** This is verbatim: + + {v + o o + /\ /\ + /\ /\ + v} + + This is preformated code: + + {[ + let verbatim s = + s |> String.split_lines |> List.map ~f:String.strip |> fun s -> + list s "@," Fmt.str + ]} *) + +(** Lists: + + list with short lines: + + - x + + list with long lines: + + - xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx + xxx xxx xxx xxx xxx xxx + + list with sub lists: + + {ul + {- xxx + + - a + } + } *) diff --git a/test/passing/refs.default/custom_list.ml.ref b/test/passing/refs.default/custom_list.ml.ref new file mode 100644 index 0000000000..b2aec183c9 --- /dev/null +++ b/test/passing/refs.default/custom_list.ml.ref @@ -0,0 +1,3 @@ +type 'a t = [] | ( :: ) of 'a * 'a t + +let _ = ( :: ) 5 diff --git a/test/passing/tests/directives.mlt.ref b/test/passing/refs.default/directives.mlt.ref similarity index 100% rename from test/passing/tests/directives.mlt.ref rename to test/passing/refs.default/directives.mlt.ref diff --git a/test/passing/refs.default/disable_attr.ml.ref b/test/passing/refs.default/disable_attr.ml.ref new file mode 100644 index 0000000000..e7671a5070 --- /dev/null +++ b/test/passing/refs.default/disable_attr.ml.ref @@ -0,0 +1,4 @@ +[@@@ocamlformat "disable"] + +(** hello *) +let foo = 42 diff --git a/test/passing/refs.default/disable_class_type.ml.ref b/test/passing/refs.default/disable_class_type.ml.ref new file mode 100644 index 0000000000..d6021357ba --- /dev/null +++ b/test/passing/refs.default/disable_class_type.ml.ref @@ -0,0 +1,8 @@ +class type c = + let open [@ocamlformat "disable"] Z + in +z + +class type c = + object [@ocamlformat "disable"] + end diff --git a/test/passing/refs.default/disable_conf_attrs.ml.err b/test/passing/refs.default/disable_conf_attrs.ml.err new file mode 100644 index 0000000000..f0b6ca23b5 --- /dev/null +++ b/test/passing/refs.default/disable_conf_attrs.ml.err @@ -0,0 +1,40 @@ +File "disable_conf_attrs.ml", line 3, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 3, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 5, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 5, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 7, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 7, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 9, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 9, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 11, characters 18-33: +Warning: Configuration in attribute "break-cases=all" ignored. +File "disable_conf_attrs.ml", line 11, characters 18-33: +Warning: Configuration in attribute "break-cases=all" ignored. +File "disable_conf_attrs.ml", line 2, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 2, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 3, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 3, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 4, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 4, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 5, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 5, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 7, characters 18-33: +Warning: Configuration in attribute "break-cases=all" ignored. +File "disable_conf_attrs.ml", line 7, characters 18-33: +Warning: Configuration in attribute "break-cases=all" ignored. diff --git a/test/passing/refs.default/disable_conf_attrs.ml.ref b/test/passing/refs.default/disable_conf_attrs.ml.ref new file mode 100644 index 0000000000..95532acc38 --- /dev/null +++ b/test/passing/refs.default/disable_conf_attrs.ml.ref @@ -0,0 +1,8 @@ +let a, b = (1, 2) +let[@ocamlformat "parens-tuple-patterns=always"] a, b = (1, 2) +let[@ocamlformat "parens-tuple-patterns=always"] M.(a, b) = () +let[@ocamlformat "parens-tuple-patterns=multi-line-only"] a, b = (1, 2) +let[@ocamlformat "parens-tuple-patterns=multi-line-only"] M.(a, b) = () + +let[@ocamlformat "break-cases=all"] _ = + try () with End_of_file | Not_found -> () diff --git a/test/passing/refs.default/disable_local_let.ml.ref b/test/passing/refs.default/disable_local_let.ml.ref new file mode 100644 index 0000000000..1ba579e4b6 --- /dev/null +++ b/test/passing/refs.default/disable_local_let.ml.ref @@ -0,0 +1,35 @@ +let f () = + let [@ocamlformat "disable"] x = y + in + () + +let f () = + let x = y [@@ocamlformat "disable"] + in + () + +let f () = let open [@ocamlformat "disable"] X + in + () + +let f () = let module [@ocamlformat "disable"] X = Y + in + () + +let f () = let exception [@ocamlformat "disable"] X + in + () + +class c = let open [@ocamlformat "disable"] X + in + x + +class c = + let [@ocamlformat "disable"] x = y + in + object end + +class type c = + let open [@ocamlformat "disable"] X + in + x diff --git a/test/passing/refs.default/disabled.ml.ref b/test/passing/refs.default/disabled.ml.ref new file mode 100644 index 0000000000..31e753ef30 --- /dev/null +++ b/test/passing/refs.default/disabled.ml.ref @@ -0,0 +1,2 @@ +(* this file does not parse and ocamlformat is disabled *) +let = in diff --git a/test/passing/refs.default/disabled_attr.ml.ref b/test/passing/refs.default/disabled_attr.ml.ref new file mode 100644 index 0000000000..a9a3f92e0c --- /dev/null +++ b/test/passing/refs.default/disabled_attr.ml.ref @@ -0,0 +1,21 @@ +let _ = + let disabled = {| + |}[@ocamlformat "disable"] in + () + +let _ = + let disabled = " + "[@ocamlformat "disable"] in + () + +let _ = + let disabled = + begin + (* xxx + + xxx *) + + y + end[@ocamlformat "disable"] + in + () diff --git a/test/passing/refs.default/disambiguate.ml.ref b/test/passing/refs.default/disambiguate.ml.ref new file mode 100644 index 0000000000..4db00a1e9b --- /dev/null +++ b/test/passing/refs.default/disambiguate.ml.ref @@ -0,0 +1,87 @@ +[@@@ocamlformat "disambiguate-non-breaking-match"] + +let () = + r := + fun () -> + f (); + g () + +let () = + r := + fun () -> + f (); + g (); + g (); + g (); + g (); + g (); + g (); + g (); + g (); + g () + +let () = + r := + function + | () -> + f (); + g () + +let () = + r := + function + | () -> + f (); + g (); + g (); + g (); + g (); + g (); + g (); + g (); + g (); + g () + +let () = + r := + match () with + | () -> + f (); + g () + +let () = + r := + match () with + | () -> + f (); + g (); + g (); + g (); + g (); + g (); + g (); + g (); + g (); + g () + +let () = + r := + try () + with () -> + f (); + g () + +let () = + r := + try () + with () -> + f (); + g (); + g (); + g (); + g (); + g (); + g (); + g (); + g (); + g () diff --git a/test/passing/refs.default/disambiguated_types.ml.ref b/test/passing/refs.default/disambiguated_types.ml.ref new file mode 100644 index 0000000000..11ae25cdad --- /dev/null +++ b/test/passing/refs.default/disambiguated_types.ml.ref @@ -0,0 +1,3 @@ +let t : int = 4 +let x : t/2 = t / 2 +let x : foo M/2.e0 e/2 = foo M / 2.e0 diff --git a/test/passing/tests/doc.mld.ref b/test/passing/refs.default/doc.mld.ref similarity index 87% rename from test/passing/tests/doc.mld.ref rename to test/passing/refs.default/doc.mld.ref index 857e8fdecd..64508de479 100644 --- a/test/passing/tests/doc.mld.ref +++ b/test/passing/refs.default/doc.mld.ref @@ -1,6 +1,6 @@ {0 Parent/Child Specification} -This parent/child specification allows more flexible output support, e.g., -per library documentation. See +This parent/child specification allows more flexible output support, e.g., per +library documentation. See {{:https://v3.ocaml.org/packages}v3.ocaml.org/packages}. The rules are; @@ -9,24 +9,24 @@ The rules are; - Compilation units must have a parent [.mld]. - The parent [.mld] file must be compiled before any of its children, and the children must be specified at the parent's compilation time. -- The output paths of [.mld] files and compilation units are subdirectories - of their parent's output directory. +- The output paths of [.mld] files and compilation units are subdirectories of + their parent's output directory. - The output directory of a [.mld] file [x.mld] with children is - [<parent_output_directory>/x], and its file name is [index.html]. That is - to say, [<parent_output_directory>/x/index.html] + [<parent_output_directory>/x], and its file name is [index.html]. That is to + say, [<parent_output_directory>/x/index.html] - The output directory of a [.mld] file [x.mld] without children is [<parent_output_directory> /x.html] - The output directory of a compilation unit [X] is [<parent_output_directory>/X/index.html] {b Note:} The [--pkg <package>] option is still supported for backward -compatibility in [odoc >= v2.0.0], although it's now equivalent to specifying -a parent [.mld] file. +compatibility in [odoc >= v2.0.0], although it's now equivalent to specifying a +parent [.mld] file. -For example, let's consider [John] whose is [Doe] and [Mark]'s father. [Doe] -has children, [Max], and page [foo], whereas [Mark] has no children. That is -to say, [john.mld], [doe.mld], [mark.mld], [max.mld], [foo.ml] respectively. -For instance; +For example, let's consider [John] whose is [Doe] and [Mark]'s father. [Doe] has +children, [Max], and page [foo], whereas [Mark] has no children. That is to say, +[john.mld], [doe.mld], [mark.mld], [max.mld], [foo.ml] respectively. For +instance; [john.mld] @@ -132,8 +132,8 @@ $ ls -R html index. v} -{b Note:} We generated HTML files only for this example, but it's very -possible to generate files in other formats (i.e, latex and man-pages) using: +{b Note:} We generated HTML files only for this example, but it's very possible +to generate files in other formats (i.e, latex and man-pages) using: - [$ odoc latex-generate -o latex <file>.odocl] - [$ odoc man-generate -o man <file>.odocl] @@ -143,11 +143,10 @@ e.g., for inspection: - [odoc <html/latex/man>-targets ...] takes a glimpse of the expected targets - [odoc compile-deps ...] lists units (with their digest) that need to be - compiled in order to compile the current compilation unit. The unit itself - and its digest is also reported in the output. + compiled in order to compile the current compilation unit. The unit itself and + its digest is also reported in the output. -For example, inspecting the dependencies required to compile [foo.cmt], we -run +For example, inspecting the dependencies required to compile [foo.cmt], we run [odoc compile-deps foo.cmt] diff --git a/test/passing/refs.default/doc_comments-after.ml.err b/test/passing/refs.default/doc_comments-after.ml.err new file mode 100644 index 0000000000..edab2da9d9 --- /dev/null +++ b/test/passing/refs.default/doc_comments-after.ml.err @@ -0,0 +1,4 @@ +Warning: doc_comments-after.ml:258 exceeds the margin +Warning: doc_comments-after.ml:259 exceeds the margin +Warning: doc_comments-after.ml:260 exceeds the margin +Warning: doc_comments-after.ml:289 exceeds the margin diff --git a/test/passing/tests/doc_comments-after.ml.ref b/test/passing/refs.default/doc_comments-after.ml.ref similarity index 94% rename from test/passing/tests/doc_comments-after.ml.ref rename to test/passing/refs.default/doc_comments-after.ml.ref index ad4ad77c2e..9f165d9504 100644 --- a/test/passing/tests/doc_comments-after.ml.ref +++ b/test/passing/refs.default/doc_comments-after.ml.ref @@ -10,7 +10,6 @@ include B include A type t = C of int (** docstring comment *) - type t = C of int [@ocaml.doc " docstring attribute "] include Mod @@ -47,7 +46,6 @@ module Comment_placement : sig (** Module *) module A : sig type a - type b end @@ -63,7 +61,6 @@ module Comment_placement : sig (** Include *) include sig type a - type b end @@ -79,7 +76,6 @@ module Comment_placement : sig (** Rec module *) module rec A : sig type a - type b end @@ -89,7 +85,6 @@ module Comment_placement : sig (** Module type *) module type A = sig type a - type b end @@ -136,7 +131,7 @@ module Comment_placement : sig module Gen () : S (** Generative functor *) end = struct - type t = {a: int} + type t = { a : int } (** Type *) (** Variant declaration *) @@ -151,14 +146,12 @@ end = struct (** Module *) module A = struct type a = A - type b = B end (** Module *) module A : sig type a - type b end = B @@ -175,7 +168,6 @@ end = struct (** Include *) include struct type a = A - type b = B end @@ -191,7 +183,6 @@ end = struct (** Rec module *) module rec A : B = struct type a = A - type b = B end @@ -201,7 +192,6 @@ end = struct (** Module type *) module type A = sig type a - type b end @@ -256,12 +246,12 @@ exception A of int module A = struct module B = struct - (** It does not try to saturate (1a) A = B + C /\ B = D + E => A = C + D - \+ E Nor combine more than 2 equations (1b) A = B + C /\ B = D + E /\ - F = C + D + E => A = F + (** It does not try to saturate (1a) A = B + C /\ B = D + E => A = C + D + E + Nor combine more than 2 equations (1b) A = B + C /\ B = D + E /\ F = C + + D + E => A = F - xxxxxxxxxxxxxxxxxxxxxxxxxxxx (2) A = B + C /\ B = D + E => A = C + D - \- E *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxx (2) A = B + C /\ B = D + E => A = C + D - E + *) let a b = () end end @@ -302,7 +292,7 @@ let a = 1 (** {@ocaml[ let _ = - f @@ {aaa= aaa bbb ccc; bbb= aaa bbb ccc; ccc= aaa bbb ccc} + f @@ { aaa = aaa bbb ccc; bbb = aaa bbb ccc; ccc = aaa bbb ccc } >>= fun () -> let _ = x in f @@ g @@ h @@ fun x -> y diff --git a/test/passing/refs.default/doc_comments-before-except-val.ml.err b/test/passing/refs.default/doc_comments-before-except-val.ml.err new file mode 100644 index 0000000000..9bc71e1a31 --- /dev/null +++ b/test/passing/refs.default/doc_comments-before-except-val.ml.err @@ -0,0 +1,4 @@ +Warning: doc_comments-before-except-val.ml:258 exceeds the margin +Warning: doc_comments-before-except-val.ml:259 exceeds the margin +Warning: doc_comments-before-except-val.ml:260 exceeds the margin +Warning: doc_comments-before-except-val.ml:289 exceeds the margin diff --git a/test/passing/tests/doc_comments-before-except-val.ml.ref b/test/passing/refs.default/doc_comments-before-except-val.ml.ref similarity index 94% rename from test/passing/tests/doc_comments-before-except-val.ml.ref rename to test/passing/refs.default/doc_comments-before-except-val.ml.ref index 66cc7751a1..142c7af6d1 100644 --- a/test/passing/tests/doc_comments-before-except-val.ml.ref +++ b/test/passing/refs.default/doc_comments-before-except-val.ml.ref @@ -10,7 +10,6 @@ include B include A type t = C of int (** docstring comment *) - type t = C of int [@ocaml.doc " docstring attribute "] (** comment *) @@ -47,7 +46,6 @@ module Comment_placement : sig (** Module *) module A : sig type a - type b end @@ -63,7 +61,6 @@ module Comment_placement : sig (** Include *) include sig type a - type b end @@ -79,7 +76,6 @@ module Comment_placement : sig (** Rec module *) module rec A : sig type a - type b end @@ -89,7 +85,6 @@ module Comment_placement : sig (** Module type *) module type A = sig type a - type b end @@ -137,7 +132,7 @@ module Comment_placement : sig module Gen () : S end = struct (** Type *) - type t = {a: int} + type t = { a : int } (** Variant declaration *) type t = T @@ -151,14 +146,12 @@ end = struct (** Module *) module A = struct type a = A - type b = B end (** Module *) module A : sig type a - type b end = B @@ -175,7 +168,6 @@ end = struct (** Include *) include struct type a = A - type b = B end @@ -191,7 +183,6 @@ end = struct (** Rec module *) module rec A : B = struct type a = A - type b = B end @@ -201,7 +192,6 @@ end = struct (** Module type *) module type A = sig type a - type b end @@ -256,12 +246,12 @@ exception A of int module A = struct module B = struct - (** It does not try to saturate (1a) A = B + C /\ B = D + E => A = C + D - \+ E Nor combine more than 2 equations (1b) A = B + C /\ B = D + E /\ - F = C + D + E => A = F + (** It does not try to saturate (1a) A = B + C /\ B = D + E => A = C + D + E + Nor combine more than 2 equations (1b) A = B + C /\ B = D + E /\ F = C + + D + E => A = F - xxxxxxxxxxxxxxxxxxxxxxxxxxxx (2) A = B + C /\ B = D + E => A = C + D - \- E *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxx (2) A = B + C /\ B = D + E => A = C + D - E + *) let a b = () end end @@ -302,7 +292,7 @@ let a = 1 (** {@ocaml[ let _ = - f @@ {aaa= aaa bbb ccc; bbb= aaa bbb ccc; ccc= aaa bbb ccc} + f @@ { aaa = aaa bbb ccc; bbb = aaa bbb ccc; ccc = aaa bbb ccc } >>= fun () -> let _ = x in f @@ g @@ h @@ fun x -> y diff --git a/test/passing/refs.default/doc_comments-before.ml.err b/test/passing/refs.default/doc_comments-before.ml.err new file mode 100644 index 0000000000..c1b82ef991 --- /dev/null +++ b/test/passing/refs.default/doc_comments-before.ml.err @@ -0,0 +1,4 @@ +Warning: doc_comments-before.ml:258 exceeds the margin +Warning: doc_comments-before.ml:259 exceeds the margin +Warning: doc_comments-before.ml:260 exceeds the margin +Warning: doc_comments-before.ml:289 exceeds the margin diff --git a/test/passing/tests/doc_comments-before.ml.ref b/test/passing/refs.default/doc_comments-before.ml.ref similarity index 94% rename from test/passing/tests/doc_comments-before.ml.ref rename to test/passing/refs.default/doc_comments-before.ml.ref index ae6ef68376..25f007dfcc 100644 --- a/test/passing/tests/doc_comments-before.ml.ref +++ b/test/passing/refs.default/doc_comments-before.ml.ref @@ -10,7 +10,6 @@ include B include A type t = C of int (** docstring comment *) - type t = C of int [@ocaml.doc " docstring attribute "] (** comment *) @@ -47,7 +46,6 @@ module Comment_placement : sig (** Module *) module A : sig type a - type b end @@ -63,7 +61,6 @@ module Comment_placement : sig (** Include *) include sig type a - type b end @@ -79,7 +76,6 @@ module Comment_placement : sig (** Rec module *) module rec A : sig type a - type b end @@ -89,7 +85,6 @@ module Comment_placement : sig (** Module type *) module type A = sig type a - type b end @@ -137,7 +132,7 @@ module Comment_placement : sig module Gen () : S end = struct (** Type *) - type t = {a: int} + type t = { a : int } (** Variant declaration *) type t = T @@ -151,14 +146,12 @@ end = struct (** Module *) module A = struct type a = A - type b = B end (** Module *) module A : sig type a - type b end = B @@ -175,7 +168,6 @@ end = struct (** Include *) include struct type a = A - type b = B end @@ -191,7 +183,6 @@ end = struct (** Rec module *) module rec A : B = struct type a = A - type b = B end @@ -201,7 +192,6 @@ end = struct (** Module type *) module type A = sig type a - type b end @@ -256,12 +246,12 @@ exception A of int module A = struct module B = struct - (** It does not try to saturate (1a) A = B + C /\ B = D + E => A = C + D - \+ E Nor combine more than 2 equations (1b) A = B + C /\ B = D + E /\ - F = C + D + E => A = F + (** It does not try to saturate (1a) A = B + C /\ B = D + E => A = C + D + E + Nor combine more than 2 equations (1b) A = B + C /\ B = D + E /\ F = C + + D + E => A = F - xxxxxxxxxxxxxxxxxxxxxxxxxxxx (2) A = B + C /\ B = D + E => A = C + D - \- E *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxx (2) A = B + C /\ B = D + E => A = C + D - E + *) let a b = () end end @@ -302,7 +292,7 @@ let a = 1 (** {@ocaml[ let _ = - f @@ {aaa= aaa bbb ccc; bbb= aaa bbb ccc; ccc= aaa bbb ccc} + f @@ { aaa = aaa bbb ccc; bbb = aaa bbb ccc; ccc = aaa bbb ccc } >>= fun () -> let _ = x in f @@ g @@ h @@ fun x -> y diff --git a/test/passing/refs.default/doc_comments-no-parse-docstrings.mli.err b/test/passing/refs.default/doc_comments-no-parse-docstrings.mli.err new file mode 100644 index 0000000000..05bdf87fee --- /dev/null +++ b/test/passing/refs.default/doc_comments-no-parse-docstrings.mli.err @@ -0,0 +1,20 @@ +Warning: doc_comments-no-parse-docstrings.mli:79 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:83 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:87 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:91 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:95 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:99 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:103 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:105 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:109 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:117 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:318 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:372 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:463 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:468 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:470 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:547 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:549 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:551 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:586 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:614 exceeds the margin diff --git a/test/passing/refs.default/doc_comments-no-parse-docstrings.mli.ref b/test/passing/refs.default/doc_comments-no-parse-docstrings.mli.ref new file mode 100644 index 0000000000..a3128e9631 --- /dev/null +++ b/test/passing/refs.default/doc_comments-no-parse-docstrings.mli.ref @@ -0,0 +1,657 @@ +(** Manpages. See {!Cmdliner.Manpage}. *) + +type block = + [ `S of string + | `P of string + | `Pre of string + | `I of string * string + | `Noblank + | `Blocks of block list ] + +include M with type t := t +(** Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod *) + +val escape : string -> string +(** [escape s] escapes [s] from the doc language. *) + +type title = string * int * string * string * string + +(** {1:standard-section-names Standard section names} *) + +val s_name : string + +(** {1:section-maps Section maps} + + Used for handling the merging of metadata doc strings. *) + +type smap + +val smap_append_block : smap -> sec:string -> block -> smap +(** [smap_append_block smap sec b] appends [b] at the end of section [sec] + creating it at the right place if needed. *) + +(** {1:content-boilerplate Content boilerplate} *) + +val s_environment_intro : block + +(** {1:output Output} *) + +type format = [ `Auto | `Pager | `Plain | `Groff ] + +val print : + ?errs:Format.formatter -> + ?subst:(string -> string option) -> + format -> + Format.formatter -> + t -> + unit + +(** {1:printers-and-escapes-used-by-cmdliner-module Printers and escapes + used by Cmdliner module} *) + +val subst_vars : + errs:Format.formatter -> + subst:(string -> string option) -> + Buffer.t -> + string -> + string +(** [subst b ~subst s], using [b], substitutes in [s] variables of the form + "$(doc)" by their [subst] definition. This leaves escapes and markup + directives $(markup,...) intact. + + @raise Invalid_argument in case of illegal syntax. *) + +val doc_to_plain : + errs:Format.formatter -> + subst:(string -> string option) -> + Buffer.t -> + string -> + string +(** [doc_to_plain b ~subst s] using [b], subsitutes in [s] variables by + their [subst] definition and renders cmdliner directives to plain text. + + @raise Invalid_argument in case of illegal syntax. *) + +val k : k +(** this is a comment + + @author foo + + @author Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @version foo + + @version Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @see <foo> foo + + @see <https://slash-create.js.org/#/docs/main/latest/class/SlashCreator?scrollTo=registerCommandsIn> this url is very long + + @since foo + + @since Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @before foo [foo] + + @before Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @deprecated [foo] + + @deprecated Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @param foo [foo] + + @param Foooooooooooooo_Baaaaaaaaaaaaar Fooooooooooo foooooooooooo fooooooooooo baaaaaaaaar + + @param Foooooooooooooooooooooooooooooooooooo_baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @raise foo [foo] + + @raise Foooooooooooooooooooooooooooooooooooo_baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @return [foo] + + @inline + + @canonical foo + + @canonical Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar *) + +val x : x +(** a comment + + @version foo *) + +(** Managing Chunks. + + This module exposes functors to store raw contents into append-only + stores as chunks of same size. It exposes the {{!AO} AO} functor which + split the raw contents into [Data] blocks, addressed by [Node] blocks. + That's the usual rope-like representation of strings, but chunk trees + are always build as perfectly well-balanced and blocks are addressed by + their hash (or by the stable keys returned by the underlying store). + + A chunk has the following structure: + + {v + -------------------------- -------------------------- + | uint8_t type | | uint8_t type | + --------------------------- --------------------------- + | uint16_t | | uint64_t | + --------------------------- --------------------------- + | key children[length] | | byte data[length] | + --------------------------- --------------------------- + v} + + [type] is either [Data] (0) or [Index] (1). If the chunk contains data, + [length] is the payload length. Otherwise it is the number of children + that the node has. + + It also exposes {{!AO_stable} AO_stable} which -- as {{!AO} AO} does -- + stores raw contents into chunks of same size. But it also preserves the + nice properpty that values are addressed by their hash. instead of by + the hash of the root chunk node as it is the case for {{!AO} AO}. *) + +(** This is verbatim: + + {v + o o + /\ /\ + /\ /\ + v} + + This is preformated code: + + {[ +let verbatim s = + s |> String.split_lines |> List.map ~f:String.strip + |> fun s -> list s "@," Fmt.str + ]} *) + +(** Lists: + + list with short lines: + + - x + - y + - z + + list with long lines: + + - xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx + xxx xxx xxx xxx xxx xxx xxx + - yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy + yyy yyy yyy yyy yyy yyy yyy + - zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz + zzz zzz zzz zzz zzz zzz zzz + + enumerated list with long lines: + + + xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx + xxx xxx xxx xxx xxx xxx xxx + + yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy + yyy yyy yyy yyy yyy yyy yyy + + zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz + zzz zzz zzz zzz zzz zzz zzz + + list with sub lists: + + {ul + {- xxx + + - a + - b + - c + } + {- yyy + + + a + + b + + c + }} *) + +(** {{:https://github.com/} Github} *) + +(** {:https://github.com/} *) + +(** An array index offset: [exp1\[exp2\]] *) + +(** to extend \{foo syntax *) + +(** The different forms of references in \@see tags. *) + +(** Printf groff string for the \@before information. *) + +(** [a]'c [b]'s [c]'c *) + +(** return true if [\gamma(lhs) \subseteq \gamma(rhs)] *) + +(** Composition of functions: [(f >> g) x] is exactly equivalent to + [g (f (x))]. Left associative. *) + +(** [†] [Struct_rec] is *) + +(** for [Global]s *) + +(** generic command: ∀xs.[foot]-[post] *) + +(** A *) +val foo : int -> unit +(** B *) + +(** C *) + +(** A *) +val foo : int -> unit +(** B *) + +module Foo : sig + (** A *) + val foo : int -> unit + (** B *) + + (** C *) + + (** A *) + val foo : int -> unit + (** B *) +end + +(** [\[ \] \[\] \]] *) + +(** \{ \} \[ \] \@ \@ *) + +(** @canonical Foo *) + +(** @canonical Module.Foo.Bar *) + +(** {v +a + v} *) + +(** {[ +b + ]} *) + +(** - Odoc don't parse + + multiple paragraph in a list *) + +(** {ul + {- Abc + + Def + } + {- Hij + } + {- Klm + + {ul + {- Nop + + Qrs + } + {- Tuv + }} + }} *) + +(** - {v + Abc + def + v} + - {[ +A + B + ]} *) + +(** Code block + {[ Single line ]} + {[ + Multi + line + ]} + {[ + Multi + line + with + indentation + ]} + {[ Single long line HAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA ]} + {[ + With empty + + line + ]} + {[ First line + on the same line + as opening ]} + *) + +module X : sig + (** {[ First line + on the same line + as opening ]} *) +end + +(** {!module:A} {!module:A.B} + + {!module-type:A} {!module-type:A.b} + + {!class:c} {!class:M.c} + + {!class-type:c} {!class-type:M.c} + + {!val:x} {!val:M.x} + + {!type:t} {!type:M.t} + + {!exception:E} {!exception:M.E} + + {!method:m} {!method:c.m} + + {!constructor:C} {!constructor:M.C} + + {!field:f} {!field:t.f} {!field:M.t.f} + *) + +(** {!modules:Foo} + + {!modules:Foo Bar.Baz} + + @canonical Foo + + @canonical Foo.Bar +*) + +(** {%html:<p>Raw markup</p>%} {%Without language%} {%other:Other language%} *) + +(** [Multi + Line] + + [ A lot of spaces ] + + [Very looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong] *) + +(** {[ + for i = 1 to 3 + do + Printf.printf "let x%d = %d\n" i i + done +]} *) + +(** {[ + print_newline (); + List.iter + (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s) + ["+"; "-"; "*"; "/"] +]} *) + +(** {[ + #use "import.cinaps";; + + List.iter all_fields ~f:(fun (name, type_) -> printf "\nexternal get_%s + : unit -> %s = \"get_%s\"" name type_ name) +]} *) + +(** {[ + + + List.iter all_fields ~f:(fun (name, type_) -> printf "\nexternal get_%s + : unit -> %s = \"get_%s\"" name type_ name) +]} *) + +(** {[ + let x = 1 in + + (* fooooooo *) + let y = 2 in + (* foooooooo *) + z +]} *) + +(** {[ + let this = is_short +]} + +{[ + does not parse: verbatim ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+ +]} + +{[ +[@@@ocamlformat "break-separators = after"] + +let fooooooooooooooooo = +[ foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo ] + +]} + +{[ +let fooooooooooooooooo = +[ foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo ] + +]} *) + +(** + This is a comment with code inside + {[ + (** This is a comment with code inside + [ let code inside = f inside ] + *) + let code inside (* comment *) = f inside + ]} + + Code block with metadata: + {@ocaml[ code ]} + + {@ocaml kind=toplevel[ code ]} + + {@ocaml kind=toplevel env=e1[ + (** This is a comment with code inside + [ let code inside = f inside ] + *) + let code inside (* comment *) = f inside + ]} +*) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo} {i fooooooooooooo oooooooo oooooooooo} {b fooooooooooooo oooooooooooo oooooo ooooooo} *) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo} {{!some ref} fooooooooooooo + oooooooo oooooooooo} {b fooooooooooooo oooooooooooo oooooo ooooooo} *) + +(** foooooooooooooooooooooooooooooooooooooooooooooooooo foooooooooooo {b eee + eee eee} *) + +(** foooooooooooooooooooooooooooooooooooooooooooooooooo foooooooooooooooo {b + eee + eee eee} *) + +val f : int + +(***) + +val k : int + +(**) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}}} *) + +(** {e + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}} foooooooo + oooooooooo ooooooooo ooooooooo} *) + +(** foooooooooo fooooooooooo + + {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}} fooooooooooooo + foooooooooo fooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}}} + + {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo}} + + fooooooooooooo foooooooooooooo: + + - foo + - {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo}} + - {e foooooooo oooooooooo ooooooooo ooooooooo} + {i fooooooooooooo oooooooo oooooooooo} + - foo *) + +(** Brackets must not be escaped in the first argument of some tags: *) + +(** @raise [Invalid_argument] if the argument is [None]. Sometimes [t.[x]]. *) + +(** @author [Abc] [def] \[hij\] *) + +(** @author {Abc} {def} \{hij\} *) + +(** @param [id] [def] \[hij\] *) + +(** @raise [exn] [def] \[hij\] *) + +(** @since [Abc] [def] \[hij\] *) + +(** @before [Abc] [def] \[hij\] *) + +(** @version [Abc] [def] \[hij\] *) + +(** @see <[Abc]> [def] \[hij\] *) + +(** @see '[Abc]' [def] \[hij\] *) + +(** @see "[Abc]" [def] \[hij\] *) + +(** \[abc\] *) + +(** *) + +(** *) + +(** [trim " "] is [""] *) + +(** [trms (c × (Σᵢ₌₁ⁿ cᵢ × Πⱼ₌₁ᵐᵢ Xᵢⱼ^pᵢⱼ))] + is the sequence of terms [Xᵢⱼ] for each [i] and [j]. *) + +(** + +Lorem ipsum dolor sit amet, consectetur adipiscing elit. Morbi lacinia odio sit amet lobortis fringilla. Mauris diam massa, vulputate sit amet lacus id, vestibulum bibendum lectus. Nullam tristique justo nisi, gravida dapibus mi pulvinar at. Suspendisse pellentesque odio quis ipsum tempor luctus. + +Cras ultrices, magna sit amet faucibus molestie, sapien dolor ullamcorper lorem, vel viverra tortor augue vel massa. Suspendisse nunc nisi, consequat et ante nec, efficitur dapibus ipsum. Aenean vitae pellentesque odio. Integer et ornare tellus, at tristique elit. + +Phasellus et nisi id neque ultrices vestibulum vitae non tortor. Mauris aliquet at risus sed rhoncus. Ut condimentum rhoncus orci, sit amet eleifend erat tempus quis. + +*) + +(** {[(* a + b *)]} *) + +val a : + fooooooooooooooooooooooooooo (** {[(* a + b *)]} *) -> + fooooooooooooooooooooooooo + +type x = { + a : t; (** {[(* a + b *)]} *) + b : [ `A (** {[(* a + b *)]} *) ]; +} + +type x = + | A of a (** {[(* a + b *)]} *) + | B of b (** {[(* a + b *)]} *) + +(** Set a different language name in the block metadata to not format as OCaml: + + {@sh[ echo "this""is""only""a""single"(echo word)(echo also) ]} *) + +(**a*) + +(**b*) + +(** Inline math: {m \infty} + + Inline math elements can wrap as well {m \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty} or {m \f\relax{x} = \int_{-\infty}^\infty \f\hat\xi\,e^{2 \pi i \xi x} \,d\xi}. + + Block math: + + {math \infty} + + {math + \infty + } + + {math + + \pi + + } + + {math + + \infty + + \pi + + \pi + + \pi + + } + + {math {m \f\relax{x} = \int_{-\infty}^\infty \f\hat\xi\,e^{2 \pi i \xi x} \,d\xi}} + + {math + % \f is defined as #1f(#2) using the macro + \f\relax{x} = \int_{-\infty}^\infty + \f\hat\xi\,e^{2 \pi i \xi x} + \,d\xi + } +*) + +(** {[ + let _ = {| + Doc-comment contains code blocks that contains string with breaks and + ending with trailing spaces. + |} + ]} *) + +(** ISO-Latin1 characters in identifiers + {[ω]}*) + +(** Here, [my_list=[]]. *) + +(** Here, [my_list=\[\]]. *) + +(** This code block will change due to the brackets being re-escaped. + [ [ \[ [] ] ]. *) + +(** at@ *) + +(** \@at *) + +(** Lists can't be nested + - foo + - module system documentation including + {ol + {- bar} + {- baz} + } +*) + +(** Space before a reference or link text is preserved. A newline is turned + into a space. {{!ref} + with newline} and {{!ref} with space}. *) diff --git a/test/passing/refs.default/doc_comments-no-wrap.mli.err b/test/passing/refs.default/doc_comments-no-wrap.mli.err new file mode 100644 index 0000000000..6a4a3e6cf8 --- /dev/null +++ b/test/passing/refs.default/doc_comments-no-wrap.mli.err @@ -0,0 +1,13 @@ +Warning: doc_comments-no-wrap.mli:79 exceeds the margin +Warning: doc_comments-no-wrap.mli:83 exceeds the margin +Warning: doc_comments-no-wrap.mli:87 exceeds the margin +Warning: doc_comments-no-wrap.mli:92 exceeds the margin +Warning: doc_comments-no-wrap.mli:96 exceeds the margin +Warning: doc_comments-no-wrap.mli:110 exceeds the margin +Warning: doc_comments-no-wrap.mli:115 exceeds the margin +Warning: doc_comments-no-wrap.mli:124 exceeds the margin +Warning: doc_comments-no-wrap.mli:328 exceeds the margin +Warning: doc_comments-no-wrap.mli:384 exceeds the margin +Warning: doc_comments-no-wrap.mli:556 exceeds the margin +Warning: doc_comments-no-wrap.mli:625 exceeds the margin +Warning: doc_comments-no-wrap.mli:648 exceeds the margin diff --git a/test/passing/tests/doc_comments-no-wrap.mli.ref b/test/passing/refs.default/doc_comments-no-wrap.mli.ref similarity index 83% rename from test/passing/tests/doc_comments-no-wrap.mli.ref rename to test/passing/refs.default/doc_comments-no-wrap.mli.ref index d7cc2e9091..306f0c1ec2 100644 --- a/test/passing/tests/doc_comments-no-wrap.mli.ref +++ b/test/passing/refs.default/doc_comments-no-wrap.mli.ref @@ -8,9 +8,8 @@ type block = | `Noblank | `Blocks of block list ] -(** Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod -*) include M with type t := t +(** Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod *) val escape : string -> string (** [escape s] escapes [s] from the doc language. *) @@ -37,25 +36,25 @@ val s_environment_intro : block (** {1:output Output} *) -type format = [`Auto | `Pager | `Plain | `Groff] +type format = [ `Auto | `Pager | `Plain | `Groff ] val print : - ?errs:Format.formatter - -> ?subst:(string -> string option) - -> format - -> Format.formatter - -> t - -> unit + ?errs:Format.formatter -> + ?subst:(string -> string option) -> + format -> + Format.formatter -> + t -> + unit -(** {1:printers-and-escapes-used-by-cmdliner-module Printers and escapes used - by Cmdliner module} *) +(** {1:printers-and-escapes-used-by-cmdliner-module Printers and escapes used by + Cmdliner module} *) val subst_vars : - errs:Format.formatter - -> subst:(string -> string option) - -> Buffer.t - -> string - -> string + errs:Format.formatter -> + subst:(string -> string option) -> + Buffer.t -> + string -> + string (** [subst b ~subst s], using [b], substitutes in [s] variables of the form "$(doc)" by their [subst] definition. This leaves escapes and markup directives $(markup,...) intact. @@ -63,11 +62,11 @@ val subst_vars : @raise Invalid_argument in case of illegal syntax. *) val doc_to_plain : - errs:Format.formatter - -> subst:(string -> string option) - -> Buffer.t - -> string - -> string + errs:Format.formatter -> + subst:(string -> string option) -> + Buffer.t -> + string -> + string (** [doc_to_plain b ~subst s] using [b], subsitutes in [s] variables by their [subst] definition and renders cmdliner directives to plain text. @@ -133,12 +132,12 @@ val x : x (** Managing Chunks. - This module exposes functors to store raw contents into append-only - stores as chunks of same size. It exposes the {{!AO} AO} functor which - split the raw contents into [Data] blocks, addressed by [Node] blocks. - That's the usual rope-like representation of strings, but chunk trees are - always build as perfectly well-balanced and blocks are addressed by their - hash (or by the stable keys returned by the underlying store). + This module exposes functors to store raw contents into append-only stores + as chunks of same size. It exposes the {{!AO} AO} functor which split the + raw contents into [Data] blocks, addressed by [Node] blocks. That's the + usual rope-like representation of strings, but chunk trees are always build + as perfectly well-balanced and blocks are addressed by their hash (or by the + stable keys returned by the underlying store). A chunk has the following structure: @@ -153,13 +152,13 @@ val x : x v} [type] is either [Data] (0) or [Index] (1). If the chunk contains data, - [length] is the payload length. Otherwise it is the number of children - that the node has. + [length] is the payload length. Otherwise it is the number of children that + the node has. It also exposes {{!AO_stable} AO_stable} which -- as {{!AO} AO} does -- - stores raw contents into chunks of same size. But it also preserves the - nice properpty that values are addressed by their hash. instead of by the - hash of the root chunk node as it is the case for {{!AO} AO}. *) + stores raw contents into chunks of same size. But it also preserves the nice + properpty that values are addressed by their hash. instead of by the hash of + the root chunk node as it is the case for {{!AO} AO}. *) (** This is verbatim: @@ -173,9 +172,8 @@ val x : x {[ let verbatim s = - s |> String.split_lines - |> List.map ~f:String.strip - |> fun s -> list s "@," Fmt.str + s |> String.split_lines |> List.map ~f:String.strip |> fun s -> + list s "@," Fmt.str ]} *) (** Lists: @@ -237,8 +235,8 @@ val x : x (** return true if [\gamma(lhs) \subseteq \gamma(rhs)] *) -(** Composition of functions: [(f >> g) x] is exactly equivalent to - [g (f (x))]. Left associative. *) +(** Composition of functions: [(f >> g) x] is exactly equivalent to [g (f (x))]. + Left associative. *) (** [†] [Struct_rec] is *) @@ -377,8 +375,7 @@ end @canonical Foo.Bar *) -(** {%html:<p>Raw markup</p>%} {%Without language%} {%other:Other language%} -*) +(** {%html:<p>Raw markup</p>%} {%Without language%} {%other:Other language%} *) (** [Multi Line] @@ -395,28 +392,27 @@ end ]} *) (** {[ - print_newline () ; + print_newline (); List.iter (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s) - ["+"; "-"; "*"; "/"] + [ "+"; "-"; "*"; "/" ] ]} *) (** {[ - #use "import.cinaps" ;; + #use "import.cinaps";; List.iter all_fields ~f:(fun (name, type_) -> - printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" name type_ - name ) + printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" name type_ name) ]} *) (** {[ List.iter all_fields ~f:(fun (name, type_) -> - printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" name type_ - name ) + printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" name type_ name) ]} *) (** {[ let x = 1 in + (* fooooooo *) let y = 2 in (* foooooooo *) @@ -439,22 +435,25 @@ end [@@@ocamlformat "break-separators = after"] let fooooooooooooooooo = - [ foooooooooooooooooooooooooooooooo; + [ + foooooooooooooooooooooooooooooooo; + foooooooooooooooooooooooooooooooo; foooooooooooooooooooooooooooooooo; - foooooooooooooooooooooooooooooooo ] + ] ]} {[ let fooooooooooooooooo = - [ foooooooooooooooooooooooooooooooo - ; foooooooooooooooooooooooooooooooo - ; foooooooooooooooooooooooooooooooo ] + [ + foooooooooooooooooooooooooooooooo; + foooooooooooooooooooooooooooooooo; + foooooooooooooooooooooooooooooooo; + ] ]} *) (** This is a comment with code inside {[ - (** This is a comment with code inside [ let code inside = f inside ] - *) + (** This is a comment with code inside [ let code inside = f inside ] *) let code inside (* comment *) = f inside ]} @@ -468,8 +467,7 @@ end ]} {@ocaml kind=toplevel env=e1[ - (** This is a comment with code inside [ let code inside = f inside ] - *) + (** This is a comment with code inside [ let code inside = f inside ] *) let code inside (* comment *) = f inside ]} *) @@ -500,8 +498,8 @@ val k : int {b fooooooooooooo oooooooooooo oooooo ooooooo}}} *) (** {e {i fooooooooooooo oooooooo oooooooooo - {b fooooooooooooo oooooooooooo oooooo ooooooo}} foooooooo - oooooooooo ooooooooo ooooooooo} *) + {b fooooooooooooo oooooooooooo oooooo ooooooo}} foooooooo oooooooooo + ooooooooo ooooooooo} *) (** foooooooooo fooooooooooo @@ -526,8 +524,7 @@ val k : int (** Brackets must not be escaped in the first argument of some tags: *) -(** @raise [Invalid_argument] if the argument is [None]. Sometimes [t.[x]]. -*) +(** @raise [Invalid_argument] if the argument is [None]. Sometimes [t.[x]]. *) (** @author [Abc] [def] \[hij\] *) @@ -557,23 +554,22 @@ val k : int (** [trim " "] is [""] *) -(** [trms (c × (Σᵢ₌₁ⁿ cᵢ × Πⱼ₌₁ᵐᵢ Xᵢⱼ^pᵢⱼ))] is the sequence of terms [Xᵢⱼ] - for each [i] and [j]. *) +(** [trms (c × (Σᵢ₌₁ⁿ cᵢ × Πⱼ₌₁ᵐᵢ Xᵢⱼ^pᵢⱼ))] is the sequence of terms [Xᵢⱼ] for + each [i] and [j]. *) -(** Lorem ipsum dolor sit amet, consectetur adipiscing elit. Morbi lacinia - odio sit amet lobortis fringilla. Mauris diam massa, vulputate sit amet - lacus id, vestibulum bibendum lectus. Nullam tristique justo nisi, - gravida dapibus mi pulvinar at. Suspendisse pellentesque odio quis ipsum - tempor luctus. +(** Lorem ipsum dolor sit amet, consectetur adipiscing elit. Morbi lacinia odio + sit amet lobortis fringilla. Mauris diam massa, vulputate sit amet lacus id, + vestibulum bibendum lectus. Nullam tristique justo nisi, gravida dapibus mi + pulvinar at. Suspendisse pellentesque odio quis ipsum tempor luctus. Cras ultrices, magna sit amet faucibus molestie, sapien dolor ullamcorper - lorem, vel viverra tortor augue vel massa. Suspendisse nunc nisi, - consequat et ante nec, efficitur dapibus ipsum. Aenean vitae pellentesque - odio. Integer et ornare tellus, at tristique elit. + lorem, vel viverra tortor augue vel massa. Suspendisse nunc nisi, consequat + et ante nec, efficitur dapibus ipsum. Aenean vitae pellentesque odio. + Integer et ornare tellus, at tristique elit. Phasellus et nisi id neque ultrices vestibulum vitae non tortor. Mauris - aliquet at risus sed rhoncus. Ut condimentum rhoncus orci, sit amet - eleifend erat tempus quis. *) + aliquet at risus sed rhoncus. Ut condimentum rhoncus orci, sit amet eleifend + erat tempus quis. *) (** {[ (* a @@ -581,25 +577,26 @@ val k : int ]} *) val a : - fooooooooooooooooooooooooooo - (** {[ - (* a - b *) - ]} *) - -> fooooooooooooooooooooooooo + fooooooooooooooooooooooooooo + (** {[ + (* a + b *) + ]} *) -> + fooooooooooooooooooooooooo -type x = - { a: t - (** {[ - (* a - b *) - ]} *) - ; b: - [ `A - (** {[ - (* a - b *) - ]} *) ] } +type x = { + a : t; + (** {[ + (* a + b *) + ]} *) + b : + [ `A + (** {[ + (* a + b *) + ]} *) ]; +} type x = | A of a @@ -613,8 +610,7 @@ type x = b *) ]} *) -(** Set a different language name in the block metadata to not format as - OCaml: +(** Set a different language name in the block metadata to not format as OCaml: {@sh[ echo "this""is""only""a""single"(echo word)(echo also) @@ -693,5 +689,5 @@ type x = } } *) -(** Space before a reference or link text is preserved. A newline is turned - into a space. {{!ref} with newline} and {{!ref} with space}. *) +(** Space before a reference or link text is preserved. A newline is turned into + a space. {{!ref} with newline} and {{!ref} with space}. *) diff --git a/test/passing/refs.default/doc_comments.ml.err b/test/passing/refs.default/doc_comments.ml.err new file mode 100644 index 0000000000..dd89f60d8e --- /dev/null +++ b/test/passing/refs.default/doc_comments.ml.err @@ -0,0 +1,4 @@ +Warning: doc_comments.ml:258 exceeds the margin +Warning: doc_comments.ml:259 exceeds the margin +Warning: doc_comments.ml:260 exceeds the margin +Warning: doc_comments.ml:289 exceeds the margin diff --git a/test/passing/tests/doc_comments.ml.ref b/test/passing/refs.default/doc_comments.ml.ref similarity index 94% rename from test/passing/tests/doc_comments.ml.ref rename to test/passing/refs.default/doc_comments.ml.ref index 66cc7751a1..9f165d9504 100644 --- a/test/passing/tests/doc_comments.ml.ref +++ b/test/passing/refs.default/doc_comments.ml.ref @@ -1,20 +1,19 @@ -(** test *) module A = B +(** test *) -(** @open *) include A - (** @open *) + include B +(** @open *) include A type t = C of int (** docstring comment *) - type t = C of int [@ocaml.doc " docstring attribute "] -(** comment *) include Mod +(** comment *) (** before *) let x = 2 @@ -32,8 +31,8 @@ let a = 0 (** A' *) module Comment_placement : sig - (** Type *) type t + (** Type *) (** Variant declaration *) type t = T @@ -41,69 +40,65 @@ module Comment_placement : sig (** Type extension *) type t += T - (** Module *) module A : B + (** Module *) (** Module *) module A : sig type a - type b end val a : b (** Val *) - (** Exception *) exception E + (** Exception *) - (** Include *) include M + (** Include *) (** Include *) include sig type a - type b end - (** Open *) open M + (** Open *) external a : b = "c" (** External *) - (** Rec module *) module rec A : B + (** Rec module *) (** Rec module *) module rec A : sig type a - type b end - (** Module type *) module type A + (** Module type *) (** Module type *) module type A = sig type a - type b end - (** Class *) class a : b + (** Class *) - (** Class type *) class type a = b + (** Class type *) (* [@@@some attribute] *) (* (** Attribute *) *) - (** Extension *) [%%some extension] + (** Extension *) (** A *) external a : b = "double_comment" @@ -114,8 +109,8 @@ module Comment_placement : sig type t end - (** This one goes after *) module Index : Index.S + (** This one goes after *) (** This one _still_ goes after *) module Index2 @@ -133,11 +128,11 @@ module Comment_placement : sig (* this could be a really long signature *) end) : S - (** Generative functor *) module Gen () : S + (** Generative functor *) end = struct + type t = { a : int } (** Type *) - type t = {a: int} (** Variant declaration *) type t = T @@ -145,20 +140,18 @@ end = struct (** Type extension *) type t += T - (** Module *) module A = B + (** Module *) (** Module *) module A = struct type a = A - type b = B end (** Module *) module A : sig type a - type b end = B @@ -166,75 +159,72 @@ end = struct (** Let *) let a = b - (** Exception *) exception E + (** Exception *) - (** Include *) include M + (** Include *) (** Include *) include struct type a = A - type b = B end - (** Open *) open M + (** Open *) external a : b = "c" (** External *) - (** Rec module *) module rec A : B = C + (** Rec module *) (** Rec module *) module rec A : B = struct type a = A - type b = B end - (** Module type *) module type A = B + (** Module type *) (** Module type *) module type A = sig type a - type b end - (** Class *) class a = b + (** Class *) (** Class *) class b = object - (** Method *) method f = 0 + (** Method *) - (** Inherit *) inherit a + (** Inherit *) - (** Val *) val x = 1 + (** Val *) - (** Constraint *) constraint 'a = [> ] + (** Constraint *) - (** Initialiser *) initializer do_init () + (** Initialiser *) end - (** Class type *) class type a = b + (** Class type *) (* [@@@some attribute] *) (* (** Attribute *) *) - (** Extension *) [%%some extension] + (** Extension *) (* ;; *) (* (** Eval *) *) @@ -256,12 +246,12 @@ exception A of int module A = struct module B = struct - (** It does not try to saturate (1a) A = B + C /\ B = D + E => A = C + D - \+ E Nor combine more than 2 equations (1b) A = B + C /\ B = D + E /\ - F = C + D + E => A = F + (** It does not try to saturate (1a) A = B + C /\ B = D + E => A = C + D + E + Nor combine more than 2 equations (1b) A = B + C /\ B = D + E /\ F = C + + D + E => A = F - xxxxxxxxxxxxxxxxxxxxxxxxxxxx (2) A = B + C /\ B = D + E => A = C + D - \- E *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxx (2) A = B + C /\ B = D + E => A = C + D - E + *) let a b = () end end @@ -302,7 +292,7 @@ let a = 1 (** {@ocaml[ let _ = - f @@ {aaa= aaa bbb ccc; bbb= aaa bbb ccc; ccc= aaa bbb ccc} + f @@ { aaa = aaa bbb ccc; bbb = aaa bbb ccc; ccc = aaa bbb ccc } >>= fun () -> let _ = x in f @@ g @@ h @@ fun x -> y diff --git a/test/passing/refs.default/doc_comments.mli.err b/test/passing/refs.default/doc_comments.mli.err new file mode 100644 index 0000000000..9964e97a46 --- /dev/null +++ b/test/passing/refs.default/doc_comments.mli.err @@ -0,0 +1,13 @@ +Warning: doc_comments.mli:79 exceeds the margin +Warning: doc_comments.mli:83 exceeds the margin +Warning: doc_comments.mli:87 exceeds the margin +Warning: doc_comments.mli:92 exceeds the margin +Warning: doc_comments.mli:96 exceeds the margin +Warning: doc_comments.mli:110 exceeds the margin +Warning: doc_comments.mli:115 exceeds the margin +Warning: doc_comments.mli:124 exceeds the margin +Warning: doc_comments.mli:328 exceeds the margin +Warning: doc_comments.mli:384 exceeds the margin +Warning: doc_comments.mli:556 exceeds the margin +Warning: doc_comments.mli:625 exceeds the margin +Warning: doc_comments.mli:648 exceeds the margin diff --git a/test/passing/tests/doc_comments.mli.ref b/test/passing/refs.default/doc_comments.mli.ref similarity index 82% rename from test/passing/tests/doc_comments.mli.ref rename to test/passing/refs.default/doc_comments.mli.ref index b07d99a66f..306f0c1ec2 100644 --- a/test/passing/tests/doc_comments.mli.ref +++ b/test/passing/refs.default/doc_comments.mli.ref @@ -8,9 +8,8 @@ type block = | `Noblank | `Blocks of block list ] -(** Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod -*) include M with type t := t +(** Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod *) val escape : string -> string (** [escape s] escapes [s] from the doc language. *) @@ -37,25 +36,25 @@ val s_environment_intro : block (** {1:output Output} *) -type format = [`Auto | `Pager | `Plain | `Groff] +type format = [ `Auto | `Pager | `Plain | `Groff ] val print : - ?errs:Format.formatter - -> ?subst:(string -> string option) - -> format - -> Format.formatter - -> t - -> unit + ?errs:Format.formatter -> + ?subst:(string -> string option) -> + format -> + Format.formatter -> + t -> + unit -(** {1:printers-and-escapes-used-by-cmdliner-module Printers and escapes used - by Cmdliner module} *) +(** {1:printers-and-escapes-used-by-cmdliner-module Printers and escapes used by + Cmdliner module} *) val subst_vars : - errs:Format.formatter - -> subst:(string -> string option) - -> Buffer.t - -> string - -> string + errs:Format.formatter -> + subst:(string -> string option) -> + Buffer.t -> + string -> + string (** [subst b ~subst s], using [b], substitutes in [s] variables of the form "$(doc)" by their [subst] definition. This leaves escapes and markup directives $(markup,...) intact. @@ -63,11 +62,11 @@ val subst_vars : @raise Invalid_argument in case of illegal syntax. *) val doc_to_plain : - errs:Format.formatter - -> subst:(string -> string option) - -> Buffer.t - -> string - -> string + errs:Format.formatter -> + subst:(string -> string option) -> + Buffer.t -> + string -> + string (** [doc_to_plain b ~subst s] using [b], subsitutes in [s] variables by their [subst] definition and renders cmdliner directives to plain text. @@ -133,12 +132,12 @@ val x : x (** Managing Chunks. - This module exposes functors to store raw contents into append-only - stores as chunks of same size. It exposes the {{!AO} AO} functor which - split the raw contents into [Data] blocks, addressed by [Node] blocks. - That's the usual rope-like representation of strings, but chunk trees are - always build as perfectly well-balanced and blocks are addressed by their - hash (or by the stable keys returned by the underlying store). + This module exposes functors to store raw contents into append-only stores + as chunks of same size. It exposes the {{!AO} AO} functor which split the + raw contents into [Data] blocks, addressed by [Node] blocks. That's the + usual rope-like representation of strings, but chunk trees are always build + as perfectly well-balanced and blocks are addressed by their hash (or by the + stable keys returned by the underlying store). A chunk has the following structure: @@ -153,13 +152,13 @@ val x : x v} [type] is either [Data] (0) or [Index] (1). If the chunk contains data, - [length] is the payload length. Otherwise it is the number of children - that the node has. + [length] is the payload length. Otherwise it is the number of children that + the node has. It also exposes {{!AO_stable} AO_stable} which -- as {{!AO} AO} does -- - stores raw contents into chunks of same size. But it also preserves the - nice properpty that values are addressed by their hash. instead of by the - hash of the root chunk node as it is the case for {{!AO} AO}. *) + stores raw contents into chunks of same size. But it also preserves the nice + properpty that values are addressed by their hash. instead of by the hash of + the root chunk node as it is the case for {{!AO} AO}. *) (** This is verbatim: @@ -173,9 +172,8 @@ val x : x {[ let verbatim s = - s |> String.split_lines - |> List.map ~f:String.strip - |> fun s -> list s "@," Fmt.str + s |> String.split_lines |> List.map ~f:String.strip |> fun s -> + list s "@," Fmt.str ]} *) (** Lists: @@ -237,8 +235,8 @@ val x : x (** return true if [\gamma(lhs) \subseteq \gamma(rhs)] *) -(** Composition of functions: [(f >> g) x] is exactly equivalent to - [g (f (x))]. Left associative. *) +(** Composition of functions: [(f >> g) x] is exactly equivalent to [g (f (x))]. + Left associative. *) (** [†] [Struct_rec] is *) @@ -377,8 +375,7 @@ end @canonical Foo.Bar *) -(** {%html:<p>Raw markup</p>%} {%Without language%} {%other:Other language%} -*) +(** {%html:<p>Raw markup</p>%} {%Without language%} {%other:Other language%} *) (** [Multi Line] @@ -395,28 +392,27 @@ end ]} *) (** {[ - print_newline () ; + print_newline (); List.iter (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s) - ["+"; "-"; "*"; "/"] + [ "+"; "-"; "*"; "/" ] ]} *) (** {[ - #use "import.cinaps" ;; + #use "import.cinaps";; List.iter all_fields ~f:(fun (name, type_) -> - printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" name type_ - name ) + printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" name type_ name) ]} *) (** {[ List.iter all_fields ~f:(fun (name, type_) -> - printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" name type_ - name ) + printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" name type_ name) ]} *) (** {[ let x = 1 in + (* fooooooo *) let y = 2 in (* foooooooo *) @@ -439,23 +435,26 @@ end [@@@ocamlformat "break-separators = after"] let fooooooooooooooooo = - [ foooooooooooooooooooooooooooooooo; + [ + foooooooooooooooooooooooooooooooo; foooooooooooooooooooooooooooooooo; - foooooooooooooooooooooooooooooooo ] + foooooooooooooooooooooooooooooooo; + ] ]} {[ let fooooooooooooooooo = - [ foooooooooooooooooooooooooooooooo - ; foooooooooooooooooooooooooooooooo - ; foooooooooooooooooooooooooooooooo ] + [ + foooooooooooooooooooooooooooooooo; + foooooooooooooooooooooooooooooooo; + foooooooooooooooooooooooooooooooo; + ] ]} *) (** This is a comment with code inside {[ - (** This is a comment with code inside [ let code inside = f inside ] - *) - let code inside (* comment *) = f inside + (** This is a comment with code inside [ let code inside = f inside ] *) + let code inside (* comment *) = f inside ]} Code block with metadata: @@ -468,9 +467,8 @@ end ]} {@ocaml kind=toplevel env=e1[ - (** This is a comment with code inside [ let code inside = f inside ] - *) - let code inside (* comment *) = f inside + (** This is a comment with code inside [ let code inside = f inside ] *) + let code inside (* comment *) = f inside ]} *) (** {e foooooooo oooooooooo ooooooooo ooooooooo} @@ -500,8 +498,8 @@ val k : int {b fooooooooooooo oooooooooooo oooooo ooooooo}}} *) (** {e {i fooooooooooooo oooooooo oooooooooo - {b fooooooooooooo oooooooooooo oooooo ooooooo}} foooooooo - oooooooooo ooooooooo ooooooooo} *) + {b fooooooooooooo oooooooooooo oooooo ooooooo}} foooooooo oooooooooo + ooooooooo ooooooooo} *) (** foooooooooo fooooooooooo @@ -526,8 +524,7 @@ val k : int (** Brackets must not be escaped in the first argument of some tags: *) -(** @raise [Invalid_argument] if the argument is [None]. Sometimes [t.[x]]. -*) +(** @raise [Invalid_argument] if the argument is [None]. Sometimes [t.[x]]. *) (** @author [Abc] [def] \[hij\] *) @@ -557,58 +554,63 @@ val k : int (** [trim " "] is [""] *) -(** [trms (c × (Σᵢ₌₁ⁿ cᵢ × Πⱼ₌₁ᵐᵢ Xᵢⱼ^pᵢⱼ))] is the sequence of terms [Xᵢⱼ] - for each [i] and [j]. *) +(** [trms (c × (Σᵢ₌₁ⁿ cᵢ × Πⱼ₌₁ᵐᵢ Xᵢⱼ^pᵢⱼ))] is the sequence of terms [Xᵢⱼ] for + each [i] and [j]. *) -(** Lorem ipsum dolor sit amet, consectetur adipiscing elit. Morbi lacinia - odio sit amet lobortis fringilla. Mauris diam massa, vulputate sit amet - lacus id, vestibulum bibendum lectus. Nullam tristique justo nisi, - gravida dapibus mi pulvinar at. Suspendisse pellentesque odio quis ipsum - tempor luctus. +(** Lorem ipsum dolor sit amet, consectetur adipiscing elit. Morbi lacinia odio + sit amet lobortis fringilla. Mauris diam massa, vulputate sit amet lacus id, + vestibulum bibendum lectus. Nullam tristique justo nisi, gravida dapibus mi + pulvinar at. Suspendisse pellentesque odio quis ipsum tempor luctus. Cras ultrices, magna sit amet faucibus molestie, sapien dolor ullamcorper - lorem, vel viverra tortor augue vel massa. Suspendisse nunc nisi, - consequat et ante nec, efficitur dapibus ipsum. Aenean vitae pellentesque - odio. Integer et ornare tellus, at tristique elit. + lorem, vel viverra tortor augue vel massa. Suspendisse nunc nisi, consequat + et ante nec, efficitur dapibus ipsum. Aenean vitae pellentesque odio. + Integer et ornare tellus, at tristique elit. Phasellus et nisi id neque ultrices vestibulum vitae non tortor. Mauris - aliquet at risus sed rhoncus. Ut condimentum rhoncus orci, sit amet - eleifend erat tempus quis. *) + aliquet at risus sed rhoncus. Ut condimentum rhoncus orci, sit amet eleifend + erat tempus quis. *) (** {[ - (* a b *) + (* a + b *) ]} *) val a : - fooooooooooooooooooooooooooo - (** {[ - (* a b *) - ]} *) - -> fooooooooooooooooooooooooo + fooooooooooooooooooooooooooo + (** {[ + (* a + b *) + ]} *) -> + fooooooooooooooooooooooooo -type x = - { a: t - (** {[ - (* a b *) - ]} *) - ; b: - [ `A - (** {[ - (* a b *) - ]} *) ] } +type x = { + a : t; + (** {[ + (* a + b *) + ]} *) + b : + [ `A + (** {[ + (* a + b *) + ]} *) ]; +} type x = | A of a (** {[ - (* a b *) + (* a + b *) ]} *) | B of b (** {[ - (* a b *) + (* a + b *) ]} *) -(** Set a different language name in the block metadata to not format as - OCaml: +(** Set a different language name in the block metadata to not format as OCaml: {@sh[ echo "this""is""only""a""single"(echo word)(echo also) @@ -687,5 +689,5 @@ type x = } } *) -(** Space before a reference or link text is preserved. A newline is turned - into a space. {{!ref} with newline} and {{!ref} with space}. *) +(** Space before a reference or link text is preserved. A newline is turned into + a space. {{!ref} with newline} and {{!ref} with space}. *) diff --git a/test/passing/refs.default/doc_comments_padding.ml.ref b/test/passing/refs.default/doc_comments_padding.ml.ref new file mode 100644 index 0000000000..ba49323da4 --- /dev/null +++ b/test/passing/refs.default/doc_comments_padding.ml.ref @@ -0,0 +1,13 @@ +type t = { a : int; (** a *) b : int (** b *) } +type t = < a : int (** a *) ; b : int (** b *) > +type t = [ `a of int (** a *) | `b of int (** b *) ] +type t = A of int (** a *) | B of int (** b *) +type t += A of int (** a *) | B of int (** b *) + +[@@@ocamlformat "doc-comments-padding=1"] + +type t = { a : int; (** a *) b : int (** b *) } +type t = < a : int (** a *) ; b : int (** b *) > +type t = [ `a of int (** a *) | `b of int (** b *) ] +type t = A of int (** a *) | B of int (** b *) +type t += A of int (** a *) | B of int (** b *) diff --git a/test/passing/refs.default/doc_repl.mld.ref b/test/passing/refs.default/doc_repl.mld.ref new file mode 100644 index 0000000000..09e9b8c704 --- /dev/null +++ b/test/passing/refs.default/doc_repl.mld.ref @@ -0,0 +1,89 @@ +Block delimiters should be on their own line: + +{[ + let x = 1 +]} + +As of odoc 2.1, a block can carry metadata: + +{@ocaml[ + let x = 2 +]} + +An OCaml block that should break: + +{[ + let x = 2 in + x + x +]} + +A toplevel phrase with no output: + +{[ + # let x = 2 and y = 3 in + x + y + ;; +]} + +A toplevel phrase with output: + +{[ + # let x = 2;; + val x : int = 2 +]} + +Many toplevel phrases without output: + +{[ + # let x = 2;; + # x + 2;; + # let x = 2 and y = 3 in + x + y + ;; +]} + +Many toplevel phrases with output: + +{[ + # let x = 2;; + val x : int = 2 + # x + 2;; + - : int = 4 + # let x = 2 and y = 3 in + x + y + ;; +]} + +Output are printed after a newline: + +{[ + # let x = 2;; val x : int = 2 + # let x = 3;; + # let x = 4;; val x : int = 4 +]} + +Excessive linebreaks are removed: + +{[ + # let x = 2 in + x + 1 + ;; + output + # let y = 3 in + y + 1 + ;; +]} + +Linebreak after `#`: + +{[ + # let x = 2 in + x + 1 + ;; +]} + +Invalid toplevel phrase/ocaml block: +{[ + - : int = + 4 +]} diff --git a/test/passing/refs.default/docstrings_toplevel_directives.mlt.ref b/test/passing/refs.default/docstrings_toplevel_directives.mlt.ref new file mode 100644 index 0000000000..689a15caf3 --- /dev/null +++ b/test/passing/refs.default/docstrings_toplevel_directives.mlt.ref @@ -0,0 +1,11 @@ +(** Header *) + +#use "something" + +let two = 2 + +[@@@warning "-labels-omitted"];; + +Clflags.strict_sequence := false + +let f () = x diff --git a/test/passing/refs.default/dune b/test/passing/refs.default/dune new file mode 100644 index 0000000000..1ddf72ce93 --- /dev/null +++ b/test/passing/refs.default/dune @@ -0,0 +1 @@ +(include ../gen/dune.inc) diff --git a/test/passing/refs.default/dune-project b/test/passing/refs.default/dune-project new file mode 100644 index 0000000000..c5d3ee94db --- /dev/null +++ b/test/passing/refs.default/dune-project @@ -0,0 +1 @@ +(lang dune 2.2) diff --git a/test/passing/refs.default/eliom_ext.eliom.ref b/test/passing/refs.default/eliom_ext.eliom.ref new file mode 100644 index 0000000000..0767be7827 --- /dev/null +++ b/test/passing/refs.default/eliom_ext.eliom.ref @@ -0,0 +1,47 @@ +let%server log str = Lwt_io.write_line Lwt_io.stdout str +let%client log = ~%(Eliom_client.server_function [%derive.json: string] log) + +let%client () = + Eliom_client.onload + (* NB The service underlying the server_function isn't available on the + client before loading the page. *) + (fun () -> Lwt.async (fun () -> log "Hello from the client to the server!")) + +let%client () = + Eliom_client.onload + (* NB The service underlying the server_function isn't available on the + client before loading the page. *) + ~foo:(fun () -> + Lwt.async (fun () -> log "Hello from the client to the server!")) + +let%client () = + Eliom_client.onload + (* NB The service underlying the server_function isn't available on the + client before loading the page. *) + ~foo:(fun () -> + Lwt.async (fun () -> log "Hello from the client to the server!")) + bar + +[%%shared +type some_type = int * string list [@@deriving json] +type another_type = A of some_type | B of another_type [@@deriving json]] + +let%server + ( (s : int Eliom_shared.React.S.t), + (f : (?step:React.step -> int -> unit) Eliom_shared.Value.t) ) = + Eliom_shared.React.S.create 0 + +let%client incr_s () = + let v = Eliom_shared.React.S.value ~%s in + ~%f (v + 1) + +let%shared msg_of_int i = Printf.sprintf "value is %d" i + +let s_as_string () : string Eliom_shared.React.S.t = + Eliom_shared.React.S.map [%shared msg_of_int] s + +let%shared () = + Eliom_registration.Html.register s (fun () () -> + Lwt.return + (Eliom_tools.F.html ~title:"hybrid" + Html.F.(body [ h1 [ txt "Salut !" ] ]))) diff --git a/test/passing/refs.default/empty_ml.ml.ref b/test/passing/refs.default/empty_ml.ml.ref new file mode 100644 index 0000000000..079a31cf58 --- /dev/null +++ b/test/passing/refs.default/empty_ml.ml.ref @@ -0,0 +1,3 @@ +(* test *) + +(* test *) diff --git a/test/passing/refs.default/empty_mli.mli.ref b/test/passing/refs.default/empty_mli.mli.ref new file mode 100644 index 0000000000..079a31cf58 --- /dev/null +++ b/test/passing/refs.default/empty_mli.mli.ref @@ -0,0 +1,3 @@ +(* test *) + +(* test *) diff --git a/test/passing/refs.default/empty_mlt.mlt.ref b/test/passing/refs.default/empty_mlt.mlt.ref new file mode 100644 index 0000000000..079a31cf58 --- /dev/null +++ b/test/passing/refs.default/empty_mlt.mlt.ref @@ -0,0 +1,3 @@ +(* test *) + +(* test *) diff --git a/test/passing/refs.default/error1.ml.err b/test/passing/refs.default/error1.ml.err new file mode 100644 index 0000000000..1f7352e78a --- /dev/null +++ b/test/passing/refs.default/error1.ml.err @@ -0,0 +1,3 @@ +ocamlformat: ignoring "error1.ml" (syntax error) +File "error1.ml", line 2, characters 0-0: +Error: Syntax error diff --git a/test/passing/refs.default/error2.ml.err b/test/passing/refs.default/error2.ml.err new file mode 100644 index 0000000000..80ff306043 --- /dev/null +++ b/test/passing/refs.default/error2.ml.err @@ -0,0 +1,5 @@ +ocamlformat: ignoring "error2.ml" (syntax error) +File "error2.ml", line 1, characters 0-1: +1 | "asdd + ^ +Error: String literal not terminated diff --git a/test/passing/refs.default/error3.ml.err b/test/passing/refs.default/error3.ml.err new file mode 100644 index 0000000000..e42c4128f0 --- /dev/null +++ b/test/passing/refs.default/error3.ml.err @@ -0,0 +1,11 @@ +ocamlformat: ignoring "error3.ml" (misplaced documentation comments - warning 50) +File "error3.ml", line 2, characters 0-13: +2 | (** a or b *) + ^^^^^^^^^^^^^ +Warning 50 [unexpected-docstring]: ambiguous documentation comment + +File "error3.ml", line 3, characters 8-16: +3 | let b = (** ? *) () + ^^^^^^^^ +Warning 50 [unexpected-docstring]: unattached documentation comment (ignored) +Hint: (Warning 50) This file contains a documentation comment (** ... *) that the OCaml compiler does not know how to attach to the AST. OCamlformat does not support these cases. You can find more information at: https://github.com/ocaml-ppx/ocamlformat#overview. If you'd like to disable this check and let ocamlformat make a choice (though it might not be consistent with the ocaml compilers and odoc), you can set the --no-comment-check option. diff --git a/test/passing/refs.default/error4.ml.err b/test/passing/refs.default/error4.ml.err new file mode 100644 index 0000000000..0a5b3b1a49 --- /dev/null +++ b/test/passing/refs.default/error4.ml.err @@ -0,0 +1,9 @@ +File "error4.ml", line 2, characters 0-13: +2 | (** a or b *) + ^^^^^^^^^^^^^ +Warning 50 [unexpected-docstring]: ambiguous documentation comment + +File "error4.ml", line 3, characters 8-16: +3 | let b = (** ? *) () + ^^^^^^^^ +Warning 50 [unexpected-docstring]: unattached documentation comment (ignored) diff --git a/test/passing/tests/error4.ml.ref b/test/passing/refs.default/error4.ml.ref similarity index 100% rename from test/passing/tests/error4.ml.ref rename to test/passing/refs.default/error4.ml.ref diff --git a/test/passing/refs.default/escaped_nl.ml.ref b/test/passing/refs.default/escaped_nl.ml.ref new file mode 100644 index 0000000000..e7f8dda477 --- /dev/null +++ b/test/passing/refs.default/escaped_nl.ml.ref @@ -0,0 +1,20 @@ +let s1 = + "No field 'install', but a field 'remove': install instructions probably \ + part of 'build'. Use the 'install' field or a .install file" + +let x = + cond 40 `Warning + "Package uses flags that aren't recognised by earlier versions in OPAM 1.2 \ + branch. At the moment, you should use a tag \"flags:foo\" instead for \ + compatibility" + ~detail:alpha_flags (alpha_flags <> []) + +let s2 = "bla bla\n bli bli blo" +let s3 = "" +let s4 = " " +let s5 = " " +let s6 = "\n" +let s7 = " \n" +let c1 = '\n' +let x1 = f x '\n' y z +let zz = "\ns " diff --git a/test/passing/refs.default/exceptions.ml.ref b/test/passing/refs.default/exceptions.ml.ref new file mode 100644 index 0000000000..8fe738bd1a --- /dev/null +++ b/test/passing/refs.default/exceptions.ml.ref @@ -0,0 +1,67 @@ +exception EvalError of Error.t [@@deriving sexp] +exception Duplicate_found of (unit -> Base.Sexp.t) * string +exception Duplicate_found of ((unit -> Base.Sexp.t) -> string) + +type t = Duplicate_found of (unit -> Base.Sexp.t) * string +type t = Duplicate_found : (unit -> Base.Sexp.t) * string -> t +type t = Duplicate_found : ((unit -> Base.Sexp.t) -> string) -> t + +module type S = sig + exception EvalError of Error.t [@@deriving sexp] + exception Duplicate_found of (unit -> Base.Sexp.t) * string + exception Duplicate_found of ((unit -> Base.Sexp.t) -> string) + + type t = Duplicate_found of (unit -> Base.Sexp.t) * string + type t = Duplicate_found : (unit -> Base.Sexp.t) * string -> t + type t = Duplicate_found : ((unit -> Base.Sexp.t) -> string) -> t +end + +let _ = + let exception Duplicate_found of (unit -> Base.Sexp.t) * string in + let exception Duplicate_found of ((unit -> Base.Sexp.t) -> string) in + () + +exception Recursion_error of (Lv6Id.long as 'id) * (string list as 'stack) + +exception + Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string + | `Unstable of Location.t * string ] ] + +exception E : _ +exception E : t +exception E : [%ext t] +exception E : (t as 'a) +exception E : (t * t) +exception E : (t -> t) +exception E : (module M) +exception E : [ `X | `Y ] +exception E : 'x +exception E : < x ; y ; .. > +exception E : #c +exception E : t #c +exception E : (t -> t) #c +exception E : a b #c +exception E : (a * b) #c +exception E : (a, b) #c +exception E : (t -> t) #c +exception E : (t as 'a) #c +exception E of _ +exception E of t +exception E of [%ext t] +exception E of (t as 'a) +exception E of (t * t) +exception E of (t -> t) +exception E of (module M) +exception E of [ `X | `Y ] +exception E of 'x +exception E of < x ; y ; .. > +exception E of #c +exception E of t #c +exception E of (t -> t) #c +exception E of a b #c +exception E of (a * b) #c +exception E of (a, b) #c +exception E of (t -> t) #c +exception E of (t as 'a) #c diff --git a/test/passing/refs.default/exceptions.mli.ref b/test/passing/refs.default/exceptions.mli.ref new file mode 100644 index 0000000000..c8bd814f7c --- /dev/null +++ b/test/passing/refs.default/exceptions.mli.ref @@ -0,0 +1,62 @@ +exception EvalError of Error.t [@@deriving sexp] +exception Duplicate_found of (unit -> Base.Sexp.t) * string +exception Duplicate_found of ((unit -> Base.Sexp.t) -> string) + +type t = Duplicate_found of (unit -> Base.Sexp.t) * string +type t = Duplicate_found : (unit -> Base.Sexp.t) * string -> t +type t = Duplicate_found : ((unit -> Base.Sexp.t) -> string) -> t + +module type S = sig + exception EvalError of Error.t [@@deriving sexp] + exception Duplicate_found of (unit -> Base.Sexp.t) * string + exception Duplicate_found of ((unit -> Base.Sexp.t) -> string) + + type t = Duplicate_found of (unit -> Base.Sexp.t) * string + type t = Duplicate_found : (unit -> Base.Sexp.t) * string -> t + type t = Duplicate_found : ((unit -> Base.Sexp.t) -> string) -> t +end + +exception Recursion_error of (Lv6Id.long as 'id) * (string list as 'stack) + +exception + Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string + | `Unstable of Location.t * string ] ] + +exception E : _ +exception E : t +exception E : [%ext t] +exception E : (t as 'a) +exception E : (t * t) +exception E : (t -> t) +exception E : (module M) +exception E : [ `X | `Y ] +exception E : 'x +exception E : < x ; y ; .. > +exception E : #c +exception E : t #c +exception E : (t -> t) #c +exception E : a b #c +exception E : (a * b) #c +exception E : (a, b) #c +exception E : (t -> t) #c +exception E : (t as 'a) #c +exception E of _ +exception E of t +exception E of [%ext t] +exception E of (t as 'a) +exception E of (t * t) +exception E of (t -> t) +exception E of (module M) +exception E of [ `X | `Y ] +exception E of 'x +exception E of < x ; y ; .. > +exception E of #c +exception E of t #c +exception E of (t -> t) #c +exception E of a b #c +exception E of (a * b) #c +exception E of (a, b) #c +exception E of (t -> t) #c +exception E of (t as 'a) #c diff --git a/test/passing/refs.default/exp_grouping-parens.ml.ref b/test/passing/refs.default/exp_grouping-parens.ml.ref new file mode 100644 index 0000000000..4f2ec01238 --- /dev/null +++ b/test/passing/refs.default/exp_grouping-parens.ml.ref @@ -0,0 +1,351 @@ +let () = + Lwt_main.run + (let a = "a" in + let b = "b" in + let c = "c" in + Lwt.return "test") + +let () = + Lwt_main.run + (let a = "a" in + let b = "b" in + let c = "c" in + Lwt.return "test") + +let () = + List.iter + (fun v -> + (* do a lot of things *) + let a = "a" in + let b = "b" in + let c = "c" in + ()) + values + +let () = + List.iter + (fun v -> + (* do a lot of things *) + let a = "a" in + let b = "b" in + let c = "c" in + ()) + values + +let () = + foooooooo + (fooooooooooooo; + foooooooo foooooooooooo; + fooooooooooo foooooooooo; + foooooooooooooooo) + +let () = + foooooooo + (fooooooooooooo; + foooooooo foooooooooooo; + fooooooooooo foooooooooo; + foooooooooooooooo) + +let () = + foooooooo + (if foooooooooooooooooooooooooooo then + if foooooooooooooooooooooooooooo then foooooooooooooooooo + else foooooooooooooooooooooooooo + else if foooooooooooooooooooooooooooooooo then + foooooooooooooooooo + (if foooooooooooooooooooooooooooo then + if foooooooooooooooooooooooooooo then foooooooooooooooooooooooo + else foooooooooooooooooooooooooo + else if foooooooooooooooooooooooooooooooo then + fooooooooooooooooooooooooooooooooooo + else if foooooooooooooooooo then foooooooooooooooooooooooooooooooooo + else fooooooooooooooooooooo) + else if foooooooooooooooooo then foooooooooooooooooooooooooooooooooo + else fooooooooooooooooooooo) + +let () = + foooooooo + (if foooooooooooooooooooooooooooo then + if foooooooooooooooooooooooooooo then foooooooooooooooooooooooo + else + foooooooooooooooooooooooooooo + (if foooooooooooooooooooooooooooo then + if foooooooooooooooooooooooooooo then foooooooooooooooooooooooo + else foooooooooooooooooooooooooo + else if foooooooooooooooooooooooooooooooo then + fooooooooooooooooooooooooooooooooooo + else if foooooooooooooooooo then foooooooooooooooooooooooooooooooooo + else fooooooooooooooooooooo) + else if foooooooooooooooooooooooooooooooo then + fooooooooooooooooooooooooooooooooooo + else if foooooooooooooooooo then foooooooooooooooooooooooooooooooooo + else fooooooooooooooooooooo) + +let _ = + a + |> + let a = b in + c + +let _ = + (let a = b in + c) + |> d + +let _ = + a := + let a = b in + c + +let _ = + (let a = b in + c) + := d + +let _ = + a + + + let a = b in + c + +let _ = + (let a = b in + c) + + d + +let _ = + f + (let a = b in + c) + +let _ = + (let a = b in + c) + d + +let _ = + a#f + (let a = b in + c) + +let _ = + (let a = b in + c) + #f + +let _ = + A + (let a = b in + c) + +let _ = + `A + (let a = b in + c) + +let _ = + { + x = + (let a = b in + c); + } + +let _ = + { + (let a = b in + c) + with + a = b; + } + +let _ = + {<x = let a = b in + c>} + +let _ = + x <- + (let a = b in + c) + +let _ = + (let a = b in + c) + .x + +let _ = + (let a = b in + c).x <- + d + +let _ = + ( (let a = b in + c), + d ) + +let _ = + (let a = b in + c + :> t) + +let _ = + let a = b in + c :: d + +let _ = + a + :: + (let a = b in + c) + +let _ = + [ + (let a = b in + c); + ] + +let _ = + [| + (let a = b in + c); + |] + +let () = if a then b (* asd *) + +[@@@ocamlformat "if-then-else=compact"] + +let _ = + if x then ( + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo) + else if y then ( + f 0; + f 2) + else ( + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo) + +let () = if a then b (* asd *) + +[@@@ocamlformat "if-then-else=fit-or-vertical"] + +let _ = + if x then ( + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo) + else if y then ( + f 0; + f 2) + else ( + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo) + +let () = + if a then + b (* asd *) + +[@@@ocamlformat "if-then-else=keyword-first"] + +let _ = + if x + then ( + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo) + else if y + then ( + f 0; + f 2) + else ( + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo) + +let () = if a then b (* asd *) + +[@@@ocamlformat "if-then-else=k-r"] + +let _ = + if x then ( + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + ) else if y then ( + f 0; + f 2 + ) else ( + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + ) + +let _ = + match x with + | A -> ( match B with A -> fooooooooooooo) + | A -> ( match B with A -> fooooooooooooo | B -> fooooooooooooo) + | A -> ( + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + | C -> fooooooooooooo + | D -> fooooooooooooo) + +let () = + (add_test + @@ + let test_name = "Test 1" in + test_name >:: fun _ -> assert_equal "a" "a"); + add_test + @@ + let test_name = "Test 2" in + test_name >:: fun _ -> assert_equal "b" "b" + +let _ = () +let _ = ( (* foo *) ) +let _ = [%ext ()] +let _ = [%ext (* foo *) ()] +let _ = x y +let _ = (* foo *) x y +let _ = [%ext x y] +let _ = [%ext (* foo *) x y] + +let _ = + begin [@landmark "parse_constant_dividends"] + market_data_items := () + end + +let () = if a then b (* asd *) + +let x = + let get_path_and_distance pv1 pv2 = + if is_loop pv1 pv2 then + Some ([], 0) + else + match Tbl.find dist_tbl (pv1, pv2) with + | None -> + (* FIXME: temporary hack to avoid Jane Street's annoying warnings. *) + begin [@warning "-3"] + try + let path', dist = Dijkstra.shortest_path pgraph pv1 pv2 in + let path = unwrap_path path' in + Tbl.set dist_tbl ~key:(pv1, pv2) ~data:(path, dist); + Some (path, dist) + with Not_found | Not_found_s _ -> None + end + | pd -> pd + in + () + +let _ = + if something_changed then + begin [@attr] + loop + end + +let _ = + match x with + | _ -> + (* xxx *) + y + +let _ = + match x with + | _ -> + begin [@foo] + y + end diff --git a/test/passing/refs.default/exp_grouping.ml.ref b/test/passing/refs.default/exp_grouping.ml.ref new file mode 100644 index 0000000000..088baf632a --- /dev/null +++ b/test/passing/refs.default/exp_grouping.ml.ref @@ -0,0 +1,409 @@ +let () = + Lwt_main.run + begin + let a = "a" in + let b = "b" in + let c = "c" in + Lwt.return "test" + end + +let () = + Lwt_main.run + (let a = "a" in + let b = "b" in + let c = "c" in + Lwt.return "test") + +let () = + List.iter + begin + fun v -> + (* do a lot of things *) + let a = "a" in + let b = "b" in + let c = "c" in + () + end + values + +let () = + List.iter + (fun v -> + (* do a lot of things *) + let a = "a" in + let b = "b" in + let c = "c" in + ()) + values + +let () = + foooooooo + begin + fooooooooooooo; + foooooooo foooooooooooo; + fooooooooooo foooooooooo; + foooooooooooooooo + end + +let () = + foooooooo + (fooooooooooooo; + foooooooo foooooooooooo; + fooooooooooo foooooooooo; + foooooooooooooooo) + +let () = + foooooooo + begin + if foooooooooooooooooooooooooooo then + if foooooooooooooooooooooooooooo then foooooooooooooooooo + else foooooooooooooooooooooooooo + else if foooooooooooooooooooooooooooooooo then + foooooooooooooooooo + begin + if foooooooooooooooooooooooooooo then + if foooooooooooooooooooooooooooo then foooooooooooooooooooooooo + else foooooooooooooooooooooooooo + else if foooooooooooooooooooooooooooooooo then + fooooooooooooooooooooooooooooooooooo + else if foooooooooooooooooo then foooooooooooooooooooooooooooooooooo + else fooooooooooooooooooooo + end + else if foooooooooooooooooo then foooooooooooooooooooooooooooooooooo + else fooooooooooooooooooooo + end + +let () = + foooooooo + (if foooooooooooooooooooooooooooo then + if foooooooooooooooooooooooooooo then foooooooooooooooooooooooo + else + foooooooooooooooooooooooooooo + (if foooooooooooooooooooooooooooo then + if foooooooooooooooooooooooooooo then foooooooooooooooooooooooo + else foooooooooooooooooooooooooo + else if foooooooooooooooooooooooooooooooo then + fooooooooooooooooooooooooooooooooooo + else if foooooooooooooooooo then foooooooooooooooooooooooooooooooooo + else fooooooooooooooooooooo) + else if foooooooooooooooooooooooooooooooo then + fooooooooooooooooooooooooooooooooooo + else if foooooooooooooooooo then foooooooooooooooooooooooooooooooooo + else fooooooooooooooooooooo) + +let _ = + a + |> + let a = b in + c + +let _ = + (let a = b in + c) + |> d + +let _ = + a := + let a = b in + c + +let _ = + (let a = b in + c) + := d + +let _ = + a + + + let a = b in + c + +let _ = + (let a = b in + c) + + d + +let _ = + f + (let a = b in + c) + +let _ = + (let a = b in + c) + d + +let _ = + a#f + (let a = b in + c) + +let _ = + (let a = b in + c) + #f + +let _ = + A + (let a = b in + c) + +let _ = + `A + (let a = b in + c) + +let _ = + { + x = + (let a = b in + c); + } + +let _ = + { + (let a = b in + c) + with + a = b; + } + +let _ = + {<x = let a = b in + c>} + +let _ = + x <- + (let a = b in + c) + +let _ = + (let a = b in + c) + .x + +let _ = + (let a = b in + c).x <- + d + +let _ = + ( (let a = b in + c), + d ) + +let _ = + (let a = b in + c + :> t) + +let _ = + let a = b in + c :: d + +let _ = + a + :: + (let a = b in + c) + +let _ = + [ + (let a = b in + c); + ] + +let _ = + [| + (let a = b in + c); + |] + +let () = + if a then begin b + (* asd *) + end + +[@@@ocamlformat "if-then-else=compact"] + +let _ = + if x then begin + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + end + else if y then begin + f 0; + f 2 + end + else begin + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + end + +let () = + if a then begin b + (* asd *) + end + +[@@@ocamlformat "if-then-else=fit-or-vertical"] + +let _ = + if x then begin + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + end + else if y then begin + f 0; + f 2 + end + else begin + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + end + +let () = + if a then begin + b + (* asd *) + end + +[@@@ocamlformat "if-then-else=keyword-first"] + +let _ = + if x + then begin + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + end + else if y + then begin + f 0; + f 2 + end + else begin + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + end + +let () = + if a + then begin + b (* asd *) + end + +[@@@ocamlformat "if-then-else=k-r"] + +let _ = + if x then begin + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + end else if y then begin + f 0; + f 2 + end else begin + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + end + +let _ = + match x with + | A -> begin match B with A -> fooooooooooooo end + | A -> begin match B with A -> fooooooooooooo | B -> fooooooooooooo end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + | C -> fooooooooooooo + | D -> fooooooooooooo + end + +let () = + begin + add_test + @@ + let test_name = "Test 1" in + test_name >:: fun _ -> assert_equal "a" "a" + end; + begin + add_test + @@ + let test_name = "Test 2" in + test_name >:: fun _ -> assert_equal "b" "b" + end + +let _ = () +let _ = ( (* foo *) ) +let _ = [%ext ()] +let _ = [%ext (* foo *) ()] + +let _ = + begin + x y + end + +let _ = + begin + (* foo *) x y + end + +let _ = + begin%ext + x y + end + +let _ = + begin%ext + (* foo *) x y + end + +let _ = + begin [@landmark "parse_constant_dividends"] + market_data_items := () + end + +let () = + if a then begin + b + (* asd *) + end + +let x = + let get_path_and_distance pv1 pv2 = + if is_loop pv1 pv2 then + Some ([], 0) + else + match Tbl.find dist_tbl (pv1, pv2) with + | None -> + (* FIXME: temporary hack to avoid Jane Street's annoying warnings. *) + begin [@warning "-3"] + try + let path', dist = Dijkstra.shortest_path pgraph pv1 pv2 in + let path = unwrap_path path' in + Tbl.set dist_tbl ~key:(pv1, pv2) ~data:(path, dist); + Some (path, dist) + with Not_found | Not_found_s _ -> None + end + | pd -> pd + in + () + +let _ = + if something_changed then + begin [@attr] + loop + end + +let _ = + match x with + | _ -> + (* xxx *) + begin + y + end + +let _ = + match x with + | _ -> + begin [@foo] + y + end diff --git a/test/passing/refs.default/exp_record.ml.ref b/test/passing/refs.default/exp_record.ml.ref new file mode 100644 index 0000000000..30ab8329fe --- /dev/null +++ b/test/passing/refs.default/exp_record.ml.ref @@ -0,0 +1,9 @@ +let x = { a = 1; b = true } +let x = { a : int = b } +let x { a : int = b } = 2 + +[@@@ocamlformat "space-around-records"] + +let x = { a = 1; b = true } +let x = { a : int = b } +let x { a : int = b } = 2 diff --git a/test/passing/refs.default/expect_test.ml.err b/test/passing/refs.default/expect_test.ml.err new file mode 100644 index 0000000000..5406e003d4 --- /dev/null +++ b/test/passing/refs.default/expect_test.ml.err @@ -0,0 +1,3 @@ +Warning: expect_test.ml:8 exceeds the margin +Warning: expect_test.ml:14 exceeds the margin +Warning: expect_test.ml:23 exceeds the margin diff --git a/test/passing/refs.default/expect_test.ml.ref b/test/passing/refs.default/expect_test.ml.ref new file mode 100644 index 0000000000..664d67b642 --- /dev/null +++ b/test/passing/refs.default/expect_test.ml.ref @@ -0,0 +1,24 @@ +let%expect_test _ = e +let%bench "test" = fun () -> () + +let%expect_test _ = + assert false; + [%expect.unreachable] +[@@expect.uncaught_exn + {| + (* CR expect_test_collector: This test expectation appears to contain a backtrace. + This is strongly discouraged as backtraces are fragile. + Please change this test to not include a backtrace. *) + + "Assert_failure test.ml:5:6" + Raised at file "test.ml", line 4, characters 6-18 + Called from file "collector/expect_test_collector.ml", line 225, characters 12-19 |}] + +let _ = + assert false; + [%expect.unreachable] +[@@expect.uncaught_exn + {| + "Assert_failure test.ml:5:6" + Raised at file "test.ml", line 4, characters 6-18 + Called from file "collector/expect_test_collector.ml", line 225, characters 12-19 |}] diff --git a/test/passing/refs.default/extensions-indent.ml.ref b/test/passing/refs.default/extensions-indent.ml.ref new file mode 100644 index 0000000000..2a986c7062 --- /dev/null +++ b/test/passing/refs.default/extensions-indent.ml.ref @@ -0,0 +1,454 @@ +let () = + [%ext expr]; + () + +let _ = (match%ext x with () -> ()) [@attr y] + +let _ = + match%ext x with + | () -> + let y = [%test let x = y] in + let%test x = d in + d + +val f : compare:[%compare: 'a] -> sexp_of:[%sexp_of: 'a] -> t + +let invariant t = + Invariant.invariant [%here] t [%sexp_of: t] (fun () -> + assert (check_t_invariant t)) +;; + +[%e? + ( xxxxxxxxx, + xxxxxxxxxxxxx, + xxxxxxxxxxxxxxxx, + xxxxxxxxxxxxxx, + xxxxxxxxxxx, + xxxxxxxxxxxxxxxxxxxx )] +;; + +[%e? + ( xxxxxxxxx, + xxxxxxxxxxxxx, + xxxxxxxxxxxxxxxx, + xxxxxxxxxxxxxx, + xxxxxxxxxxx, + xxxxxxxxxxxxxxxxxxxx ) when a < b] + [%ext + let f = () and g () = () in + e] + (let%ext f = () and g () = () in + e) + [%ext + let rec f = () and g () = () in + e] + (let%ext rec f = () and g () = () in + e) + +let _ = ([%ext? (x : x)] : [%ext? (x : x)]) + +[%%ext 11111111111111111111] +[%%ext 11111111111111111111111 22222222222222222222222 33333333333333333333333] + +[%%ext +11111111111111111111;; +22222222222222222222] + +[%%ext +11111111111111111111;; +22222222222222222222;; +33333333333333333333] + +[%%ext +let foooooooooooooooo = foooo +let fooooooooooooooo = foo] + +let _ = [%stri let [%p xxx] = fun (t : [%t tt]) (ut : [%t tt]) -> [%e xxx]] + +let _ = + [ + x; + x + ---> [%expr + [%e x ~loc [%expr x] x]; + iter tail]; + x; + ] + +let _ = + [%expr + let x = e in + f y] + [@x] + +let _ = + f + (for i = 0 to 1 do + () + done) + (while true do + () + done) + +let _ = + f + (for%ext i = 0 to 1 do + () + done) + (while%ext true do + () + done) + +let _ = function%ext x -> x +let _ = f (function%ext x -> x) +let _ = f (function%ext x -> x) x +let _ = [%ext function x -> x] +let _ = f [%ext function x -> x] +let _ = f [%ext function x -> x] x +let _ = f ([%ext e] [@attr]) x + +let _ = + a;%ext + b; + [%ext + a; + b] + +let _ = try%lwt Lwt.return 2 with _ -> assert false + +let _ = + (* foooooooooooo *) + try%lwt + (* fooooooooooo *) + Lwt.return 2 + with _ -> assert false + +let _ = + try%lwt + let a = 3 in + Lwt.return a + with _ -> assert false + +let _ = + (* foooooooooooo *) + try%lwt + (* fooooooooooo *) + let a = 3 in + Lwt.return a + with _ -> assert false + +let%lwt f = function _ -> () + +type%any_extension t = < a : 'a > + +let value = f [%any_extension function 0 -> false | _ -> true] +let value = [%any_extension fun x -> y] x +let value = f [%any_extension try x with x -> false | _ -> true] +let value = f [%any_extension match x with x -> false | _ -> true] + +let foo = + [%foooooooooo + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] +[@@foooooooooo + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%foooooooooo: + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[@@@foooooooooo + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +let _ = + [%ext + let+ a = b in + c] + +let _ = + [%ext + "foo"; + "bar"] + +let this_function_has_a_long_name plus very many arguments = + "and a kind of long body" + +[%%expect {||}];; + +[%expect {| +___________________________________________________________ +|}] + +[%%expect {| +___________________________________________________________ +|}] + +let () = + (* -1 *) + [%(* 0 *) + (* 0.5 *) + test + () (* 1 *) [@foo (* 2 *) "bar"] (* 3 *)] + +open%ext M + +[%%ext open M] + +open! %ext M + +[%%ext open! M] + +include%ext M + +[%%ext include M] + +let x = + let open%ext M in + x + +let x = + [%ext + let open M in + x] + +let x = + let open! %ext M in + x + +let x = + [%ext + let open! M in + x] + +exception%ext E + +[%%ext exception E] + +let _ = + let exception%ext E in + x + +let _ = + [%ext + let exception E in + x] + +module%ext E = P + +[%%ext module E = P] + +module%ext rec K = A +and L = A + +[%%ext + module rec K = A + and L = A] + +let _ = + let module%ext E = P in + x + +let _ = + [%ext + let module E = P in + x] + +module type%ext E = P + +[%%ext module type E = P] + +class%ext x = y + +[%%ext class x = y] + +class%ext x = y + +and y = z + +[%%ext + class x = y + + and y = z] + +class type%ext x = y + +[%%ext class type x = y] + +class type%ext x = y + +and y = z + +[%%ext + class type x = y + + and y = z] + +let _ = (* bar *) [%expr (* comment *) foo (* blabla *)] +let _ = assert%lwt false +let _ = [%lwt assert false] +let _ = f (assert%lwt false) +let _ = f [%lwt assert false] +let _ = (assert%lwt false) [@attr] +let _ = [%lwt assert false] [@attr] +let _ = f ((assert%lwt false) [@attr]) +let _ = f ([%lwt assert false] [@attr]) +let _ = lazy%ext e +let _ = [%ext lazy e] +let _ = f (lazy%ext e) +let _ = f [%ext lazy e] +let _ = (lazy%ext e) [@attr] +let _ = [%ext lazy e] [@attr] +let _ = f ((lazy%ext e) [@attr]) +let _ = f ([%ext lazy e] [@attr]) + +let _ = + object%ext + method x = y + end + +let _ = + [%ext + object + method x = y + end] + +let _ = + f + (object%ext + method x = y + end) + +let _ = + f + [%ext + object + method x = y + end] + +let _ = + (object%ext + method x = y + end) + [@attr] + +let _ = + [%ext + object + method x = y + end] + [@attr] + +let _ = + f + ((object%ext + method x = y + end) + [@attr]) + +let _ = + f + ([%ext + object + method x = y + end] + [@attr]) + +let _ = if%ext x then y else z +let _ = [%ext if x then y else z] +let _ = f (if%ext x then y else z) +let _ = f [%ext if x then y else z] +let _ = (if%ext x then y else z) [@attr] +let _ = [%ext if x then y else z] [@attr] +let _ = f ((if%ext x then y else z) [@attr]) +let _ = f ([%ext if x then y else z] [@attr]) +let _ = match%ext x with _ -> x +let _ = [%ext match x with _ -> x] +let _ = f (match%ext x with _ -> x) +let _ = f [%ext match x with _ -> x] +let _ = (match%ext x with _ -> x) [@attr] +let _ = [%ext match x with _ -> x] [@attr] +let _ = f ((match%ext x with _ -> x) [@attr]) +let _ = f ([%ext match x with _ -> x] [@attr]) +let _ = try%ext x with _ -> x +let _ = [%ext try x with _ -> x] +let _ = f (try%ext x with _ -> x) +let _ = f [%ext try x with _ -> x] +let _ = (try%ext x with _ -> x) [@attr] +let _ = [%ext try x with _ -> x] [@attr] +let _ = f ((try%ext x with _ -> x) [@attr]) +let _ = f ([%ext try x with _ -> x] [@attr]) +let _ = fun%ext x -> x +let _ = [%ext fun x -> x] +let _ = f (fun%ext x -> x) +let _ = f [%ext fun x -> x] +let _ = (fun%ext x -> x) [@attr] +let _ = [%ext fun x -> x] [@attr] +let _ = f ((fun%ext x -> x) [@attr]) +let _ = f ([%ext fun x -> x] [@attr]) +let _ = function%ext x -> x +let _ = [%ext function x -> x] +let _ = f (function%ext x -> x) +let _ = f [%ext function x -> x] +let _ = (function%ext x -> x) [@attr] +let _ = [%ext function x -> x] [@attr] +let _ = f ((function%ext x -> x) [@attr]) +let _ = f ([%ext function x -> x] [@attr]) +let _ = new%ext x +let _ = [%ext new x] +let _ = f (new%ext x) +let _ = f [%ext new x] +let _ = (new%ext x) [@attr] +let _ = [%ext new x] [@attr] +let _ = f ((new%ext x) [@attr]) +let _ = f ([%ext new x] [@attr]) + +let _ = + x;%ext + y + +let _ = + [%ext + x; + y] + +let _ = + f + (x;%ext + y) + +let _ = + f + [%ext + x; + y] + +let _ = + (x;%ext + y) + [@attr] + +let _ = + [%ext + x; + y] + [@attr] + +let _ = + f + ((x;%ext + y) + [@attr]) + +let _ = + f + ([%ext + x; + y] + [@attr]) diff --git a/test/passing/refs.default/extensions-indent.mli.ref b/test/passing/refs.default/extensions-indent.mli.ref new file mode 100644 index 0000000000..cf63a0a941 --- /dev/null +++ b/test/passing/refs.default/extensions-indent.mli.ref @@ -0,0 +1,88 @@ +type%foo t = < .. > + +type t = + [%foooooooooo + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] +[@@foooooooooo + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%foooooooooo + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%foooooooooo: + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[@@@foooooooooo + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%ext +val foooooooooooooooooooooo : fooooooooooo +val fooooooooooooooooooooooooooo : fooooo] + +exception%ext E + +[%%ext exception E] + +include%ext M + +[%%ext include M] + +module type%ext T = M + +[%%ext module type T = M] + +module%ext T : M + +[%%ext: module T : M] + +module%ext rec T : M +and Z : Q + +[%%ext: + module rec T : M + and Z : Q] + +module%ext T := M + +[%%ext: module T := M] + +open%ext M +open! %ext M + +[%%ext open M] +[%%ext open! M] + +type%foo t += T + +[%%foo: type t += T] + +val%foo x : t + +[%%foo: val x : t] + +external%foo x : t = "" + +[%%foo: external x : t = ""] + +class%foo x : t + +[%%foo: class x : t] + +class type%foo x = x + +[%%foo: class type x = x] + +type%ext t := x + +[%%ext: type t := x] diff --git a/test/passing/refs.default/extensions.ml.ref b/test/passing/refs.default/extensions.ml.ref new file mode 100644 index 0000000000..6f4c413252 --- /dev/null +++ b/test/passing/refs.default/extensions.ml.ref @@ -0,0 +1,454 @@ +let () = + [%ext expr]; + () + +let _ = (match%ext x with () -> ()) [@attr y] + +let _ = + match%ext x with + | () -> + let y = [%test let x = y] in + let%test x = d in + d + +val f : compare:[%compare: 'a] -> sexp_of:[%sexp_of: 'a] -> t + +let invariant t = + Invariant.invariant [%here] t [%sexp_of: t] (fun () -> + assert (check_t_invariant t)) +;; + +[%e? + ( xxxxxxxxx, + xxxxxxxxxxxxx, + xxxxxxxxxxxxxxxx, + xxxxxxxxxxxxxx, + xxxxxxxxxxx, + xxxxxxxxxxxxxxxxxxxx )] +;; + +[%e? + ( xxxxxxxxx, + xxxxxxxxxxxxx, + xxxxxxxxxxxxxxxx, + xxxxxxxxxxxxxx, + xxxxxxxxxxx, + xxxxxxxxxxxxxxxxxxxx ) when a < b] + [%ext + let f = () and g () = () in + e] + (let%ext f = () and g () = () in + e) + [%ext + let rec f = () and g () = () in + e] + (let%ext rec f = () and g () = () in + e) + +let _ = ([%ext? (x : x)] : [%ext? (x : x)]) + +[%%ext 11111111111111111111] +[%%ext 11111111111111111111111 22222222222222222222222 33333333333333333333333] + +[%%ext +11111111111111111111;; +22222222222222222222] + +[%%ext +11111111111111111111;; +22222222222222222222;; +33333333333333333333] + +[%%ext +let foooooooooooooooo = foooo +let fooooooooooooooo = foo] + +let _ = [%stri let [%p xxx] = fun (t : [%t tt]) (ut : [%t tt]) -> [%e xxx]] + +let _ = + [ + x; + x + ---> [%expr + [%e x ~loc [%expr x] x]; + iter tail]; + x; + ] + +let _ = + [%expr + let x = e in + f y] + [@x] + +let _ = + f + (for i = 0 to 1 do + () + done) + (while true do + () + done) + +let _ = + f + (for%ext i = 0 to 1 do + () + done) + (while%ext true do + () + done) + +let _ = function%ext x -> x +let _ = f (function%ext x -> x) +let _ = f (function%ext x -> x) x +let _ = [%ext function x -> x] +let _ = f [%ext function x -> x] +let _ = f [%ext function x -> x] x +let _ = f ([%ext e] [@attr]) x + +let _ = + a;%ext + b; + [%ext + a; + b] + +let _ = try%lwt Lwt.return 2 with _ -> assert false + +let _ = + (* foooooooooooo *) + try%lwt + (* fooooooooooo *) + Lwt.return 2 + with _ -> assert false + +let _ = + try%lwt + let a = 3 in + Lwt.return a + with _ -> assert false + +let _ = + (* foooooooooooo *) + try%lwt + (* fooooooooooo *) + let a = 3 in + Lwt.return a + with _ -> assert false + +let%lwt f = function _ -> () + +type%any_extension t = < a : 'a > + +let value = f [%any_extension function 0 -> false | _ -> true] +let value = [%any_extension fun x -> y] x +let value = f [%any_extension try x with x -> false | _ -> true] +let value = f [%any_extension match x with x -> false | _ -> true] + +let foo = + [%foooooooooo + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] +[@@foooooooooo + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%foooooooooo: +fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo +foooooooooooooooooooooooooooooooooo +foooooooooooooooooooooooooooo +foooooooooooooooooooooooooooo] + +[@@@foooooooooo +fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +let _ = + [%ext + let+ a = b in + c] + +let _ = + [%ext + "foo"; + "bar"] + +let this_function_has_a_long_name plus very many arguments = + "and a kind of long body" + +[%%expect {||}];; + +[%expect {| +___________________________________________________________ +|}] + +[%%expect {| +___________________________________________________________ +|}] + +let () = + (* -1 *) + [%(* 0 *) + (* 0.5 *) + test + () (* 1 *) [@foo (* 2 *) "bar"] (* 3 *)] + +open%ext M + +[%%ext open M] + +open! %ext M + +[%%ext open! M] + +include%ext M + +[%%ext include M] + +let x = + let open%ext M in + x + +let x = + [%ext + let open M in + x] + +let x = + let open! %ext M in + x + +let x = + [%ext + let open! M in + x] + +exception%ext E + +[%%ext exception E] + +let _ = + let exception%ext E in + x + +let _ = + [%ext + let exception E in + x] + +module%ext E = P + +[%%ext module E = P] + +module%ext rec K = A +and L = A + +[%%ext +module rec K = A +and L = A] + +let _ = + let module%ext E = P in + x + +let _ = + [%ext + let module E = P in + x] + +module type%ext E = P + +[%%ext module type E = P] + +class%ext x = y + +[%%ext class x = y] + +class%ext x = y + +and y = z + +[%%ext +class x = y + +and y = z] + +class type%ext x = y + +[%%ext class type x = y] + +class type%ext x = y + +and y = z + +[%%ext +class type x = y + +and y = z] + +let _ = (* bar *) [%expr (* comment *) foo (* blabla *)] +let _ = assert%lwt false +let _ = [%lwt assert false] +let _ = f (assert%lwt false) +let _ = f [%lwt assert false] +let _ = (assert%lwt false) [@attr] +let _ = [%lwt assert false] [@attr] +let _ = f ((assert%lwt false) [@attr]) +let _ = f ([%lwt assert false] [@attr]) +let _ = lazy%ext e +let _ = [%ext lazy e] +let _ = f (lazy%ext e) +let _ = f [%ext lazy e] +let _ = (lazy%ext e) [@attr] +let _ = [%ext lazy e] [@attr] +let _ = f ((lazy%ext e) [@attr]) +let _ = f ([%ext lazy e] [@attr]) + +let _ = + object%ext + method x = y + end + +let _ = + [%ext + object + method x = y + end] + +let _ = + f + (object%ext + method x = y + end) + +let _ = + f + [%ext + object + method x = y + end] + +let _ = + (object%ext + method x = y + end) + [@attr] + +let _ = + [%ext + object + method x = y + end] + [@attr] + +let _ = + f + ((object%ext + method x = y + end) + [@attr]) + +let _ = + f + ([%ext + object + method x = y + end] + [@attr]) + +let _ = if%ext x then y else z +let _ = [%ext if x then y else z] +let _ = f (if%ext x then y else z) +let _ = f [%ext if x then y else z] +let _ = (if%ext x then y else z) [@attr] +let _ = [%ext if x then y else z] [@attr] +let _ = f ((if%ext x then y else z) [@attr]) +let _ = f ([%ext if x then y else z] [@attr]) +let _ = match%ext x with _ -> x +let _ = [%ext match x with _ -> x] +let _ = f (match%ext x with _ -> x) +let _ = f [%ext match x with _ -> x] +let _ = (match%ext x with _ -> x) [@attr] +let _ = [%ext match x with _ -> x] [@attr] +let _ = f ((match%ext x with _ -> x) [@attr]) +let _ = f ([%ext match x with _ -> x] [@attr]) +let _ = try%ext x with _ -> x +let _ = [%ext try x with _ -> x] +let _ = f (try%ext x with _ -> x) +let _ = f [%ext try x with _ -> x] +let _ = (try%ext x with _ -> x) [@attr] +let _ = [%ext try x with _ -> x] [@attr] +let _ = f ((try%ext x with _ -> x) [@attr]) +let _ = f ([%ext try x with _ -> x] [@attr]) +let _ = fun%ext x -> x +let _ = [%ext fun x -> x] +let _ = f (fun%ext x -> x) +let _ = f [%ext fun x -> x] +let _ = (fun%ext x -> x) [@attr] +let _ = [%ext fun x -> x] [@attr] +let _ = f ((fun%ext x -> x) [@attr]) +let _ = f ([%ext fun x -> x] [@attr]) +let _ = function%ext x -> x +let _ = [%ext function x -> x] +let _ = f (function%ext x -> x) +let _ = f [%ext function x -> x] +let _ = (function%ext x -> x) [@attr] +let _ = [%ext function x -> x] [@attr] +let _ = f ((function%ext x -> x) [@attr]) +let _ = f ([%ext function x -> x] [@attr]) +let _ = new%ext x +let _ = [%ext new x] +let _ = f (new%ext x) +let _ = f [%ext new x] +let _ = (new%ext x) [@attr] +let _ = [%ext new x] [@attr] +let _ = f ((new%ext x) [@attr]) +let _ = f ([%ext new x] [@attr]) + +let _ = + x;%ext + y + +let _ = + [%ext + x; + y] + +let _ = + f + (x;%ext + y) + +let _ = + f + [%ext + x; + y] + +let _ = + (x;%ext + y) + [@attr] + +let _ = + [%ext + x; + y] + [@attr] + +let _ = + f + ((x;%ext + y) + [@attr]) + +let _ = + f + ([%ext + x; + y] + [@attr]) diff --git a/test/passing/refs.default/extensions.mli.ref b/test/passing/refs.default/extensions.mli.ref new file mode 100644 index 0000000000..2449e727b8 --- /dev/null +++ b/test/passing/refs.default/extensions.mli.ref @@ -0,0 +1,88 @@ +type%foo t = < .. > + +type t = + [%foooooooooo + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] +[@@foooooooooo + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%foooooooooo +fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%foooooooooo: +fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo +foooooooooooooooooooooooooooooooooo +foooooooooooooooooooooooooooo +foooooooooooooooooooooooooooo] + +[@@@foooooooooo +fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%ext +val foooooooooooooooooooooo : fooooooooooo +val fooooooooooooooooooooooooooo : fooooo] + +exception%ext E + +[%%ext exception E] + +include%ext M + +[%%ext include M] + +module type%ext T = M + +[%%ext module type T = M] + +module%ext T : M + +[%%ext: module T : M] + +module%ext rec T : M +and Z : Q + +[%%ext: +module rec T : M +and Z : Q] + +module%ext T := M + +[%%ext: module T := M] + +open%ext M +open! %ext M + +[%%ext open M] +[%%ext open! M] + +type%foo t += T + +[%%foo: type t += T] + +val%foo x : t + +[%%foo: val x : t] + +external%foo x : t = "" + +[%%foo: external x : t = ""] + +class%foo x : t + +[%%foo: class x : t] + +class type%foo x = x + +[%%foo: class type x = x] + +type%ext t := x + +[%%ext: type t := x] diff --git a/test/passing/tests/extensions_exp_grouping.ml.ref b/test/passing/refs.default/extensions_exp_grouping.ml.ref similarity index 80% rename from test/passing/tests/extensions_exp_grouping.ml.ref rename to test/passing/refs.default/extensions_exp_grouping.ml.ref index 9e24406aeb..ef23055d19 100644 --- a/test/passing/tests/extensions_exp_grouping.ml.ref +++ b/test/passing/refs.default/extensions_exp_grouping.ml.ref @@ -36,28 +36,33 @@ let _ = end] let _ = (module%ext S) - let _ = [%ext (module S)] - let _ = f (module%ext S) - let _ = f [%ext (module S)] - let _ = (module%ext S : S) - let _ = [%ext (module S : S)] - let _ = f (module%ext S : S) - let _ = f [%ext (module S : S)] -let _ = x ;%ext y +let _ = + x;%ext + y -let _ = [%ext x ; y] +let _ = + [%ext + x; + y] -let _ = f (x ;%ext y) +let _ = + f + (x;%ext + y) -let _ = f [%ext x ; y] +let _ = + f + [%ext + x; + y] let _ = match w with @@ -74,10 +79,11 @@ let _ = let a = (* test *) - Lwt.return () ;%lwt Lwt.return 1 + Lwt.return ();%lwt + Lwt.return 1 let a = f - ( (* test *) - Lwt.return () ;%lwt - Lwt.return 1 ) + ((* test *) + Lwt.return ();%lwt + Lwt.return 1) diff --git a/test/passing/refs.default/field-op_begin_line.ml.ref b/test/passing/refs.default/field-op_begin_line.ml.ref new file mode 100644 index 0000000000..8ad1942ad3 --- /dev/null +++ b/test/passing/refs.default/field-op_begin_line.ml.ref @@ -0,0 +1,26 @@ +let foo = + entry.logdata.value_end + <- entry.logdata.value_end - !remove_size + testtesttest; + entry.logdata.value_end + <- (entry.logdata.value_end - !remove_size + testtesttest) [@foo]; + (* foooooooooo *) + entry.logdata.value_end + <- (entry.logdata.value_end - !remove_size + testtesttest) [@foo] + (* foooooooooooo *); + entry.logdata.value_end + <- entry.logdata.value_end - !remove_size + testtesttest + (* fooooooooooooooooooooooooo *); + value_end + <- entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest; + value_end + <- (entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest) + [@foo]; + value_end + <- (entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest) + [@foo] + (* fooooooooooooo *); + (* foooooooooooooooooooo *) + value_end + <- entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest + (* foooooooo *); + foo diff --git a/test/passing/refs.default/field.ml.ref b/test/passing/refs.default/field.ml.ref new file mode 100644 index 0000000000..9d6026f29e --- /dev/null +++ b/test/passing/refs.default/field.ml.ref @@ -0,0 +1,26 @@ +let foo = + entry.logdata.value_end <- + entry.logdata.value_end - !remove_size + testtesttest; + entry.logdata.value_end <- + (entry.logdata.value_end - !remove_size + testtesttest) [@foo]; + (* foooooooooo *) + entry.logdata.value_end <- + (entry.logdata.value_end - !remove_size + testtesttest) [@foo] + (* foooooooooooo *); + entry.logdata.value_end <- + entry.logdata.value_end - !remove_size + testtesttest + (* fooooooooooooooooooooooooo *); + value_end <- + entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest; + value_end <- + (entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest) + [@foo]; + value_end <- + (entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest) + [@foo] + (* fooooooooooooo *); + (* foooooooooooooooooooo *) + value_end <- + entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest + (* foooooooo *); + foo diff --git a/test/passing/refs.default/first_class_module.ml.ref b/test/passing/refs.default/first_class_module.ml.ref new file mode 100644 index 0000000000..cb3e082e9a --- /dev/null +++ b/test/passing/refs.default/first_class_module.ml.ref @@ -0,0 +1,117 @@ +module type S = sig end + +type t = (module S) + +module type S = sig + val x : int +end + +module M = struct + let x = 0 +end + +let m = (module M : S) + +let () = + let (module M : S) = m in + (* error here *) + () + +module type S = sig + val x : int +end + +module M = struct + let x = 0 +end + +let m = (module M : S) + +let f ((module M : S) as u) = + ignore u; + M.x + +let f (T { m = (module M) }) = + ignore u; + M.x + +let f (T { m = (module M : S) }) = + ignore u; + M.x + +let v = f (module M : S with type t = t) + +module type S = sig + type a + + val va : a + + type b + + val vb : b +end + +let f (module M : S with type a = int and type b = int) = M.va + M.vb + +let f (module M : S with type a = int and type b = int) + (module N : SSSS + with type a = int + and type b = int + and type c = int + and type d = int + and type e = int) + (module N : SSSS + with type a = int + and type b = int + and type c = int + and type d = int) + (module O : S with type a = int and type b = int and type c = int) = + M.va + N.vb + +module type M = sig + val storage : (module S with type t = t) +end + +let _ = + let module M = (val m : M) in + () + +let _ = + (module Ephemeron (HHHHHHHHHHHHHHHHHHHHHHHHHH) (HHHHHHHHHHHHHHHHHHHHHHHHHH) + : Ephemeron.S) + +let _ = + (module Ephemeron (HHHHHHHHHHHHHHHHHHHHHHHHHH) (HHHHHHHHHHHHHHHHHH) + : Ephemeron.S) + +let _ = (module Ephemeron (HHHHHHHHHHHHHHH) (HHHHHHHHHHHHH) : Ephemeron.S) +let _ = (module Ephemeron (HHH) : Ephemeron.S) + +let _ = + (module Ephemeron (struct + type t = t + end) : Ephemeron.S) + +let _ = + (module struct + let a = b + end) + +(* Tests for dropped comment *) + +module M = (val x : S (* a *)) +module M = (val x (* b *)) + +[@@@ocamlformat "break-struct=natural"] + +let _ = (module struct let x = 0 let y = 1 end) + +(* Three form that have an equivalent AST: *) +let x : (module S) = (module M) +let x = (module M : S) +let x = (module M : S) + +(* Unpack containing a [pexp_constraint]. *) +module T = (val (x : (module S))) + +let _ = (module Int : T[@foo]) diff --git a/test/passing/refs.default/floating_doc.ml.ref b/test/passing/refs.default/floating_doc.ml.ref new file mode 100644 index 0000000000..64257a1e80 --- /dev/null +++ b/test/passing/refs.default/floating_doc.ml.ref @@ -0,0 +1,11 @@ +type t = int + +(** Floating doc comment *) + +and u = float + +let f = () + +(** pesky doc comment *) + +and g = () diff --git a/test/passing/refs.default/for_while.ml.ref b/test/passing/refs.default/for_while.ml.ref new file mode 100644 index 0000000000..302082073d --- /dev/null +++ b/test/passing/refs.default/for_while.ml.ref @@ -0,0 +1,50 @@ +let () = + foo + (for i = 1 to 10 do + () + done) + +let () = + foo + (while true do + () + done) + +let _ = + for i = some expr to 1000 do + test this + done + +let _ = + for + something_big = some big expression + to something biggggggggggggggggggggggggggggggg + do + test this + done + +let _ = + for + something_big = some big expressionnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn + to something biggggggggggggggggggggggggggggggg + alsooooooooooooooooooooooooooooooooooooooooooo + do + test this + done + +let _ = + for + something_big = some big expressionnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn + downto something biggggggggggggggggggggggggggggggg + alsooooooooooooooooooooooooooooooooooooooooooo + do + test this + done + +let _ = + while + some bigggggggggggggggggggggg + expressionnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn + do + test this + done diff --git a/test/passing/refs.default/fun_decl-no-wrap-fun-args.ml.ref b/test/passing/refs.default/fun_decl-no-wrap-fun-args.ml.ref new file mode 100644 index 0000000000..4b1917d672 --- /dev/null +++ b/test/passing/refs.default/fun_decl-no-wrap-fun-args.ml.ref @@ -0,0 +1,112 @@ +let _ = fun (x : int) : int -> some_large_computation +let _ = fun (x : int) : int -> (some_large_computation : int) +let fooo = List.foooo ~f:(fun foooo foooo : bool -> foooooooooooooooooooooo) + +let _ = + fun (x : int) + (x : int) + (x : int) + (x : int) + (x : int) + : + fooooooooooooooooooooooooooo foooooooooooooo foooooooooo -> + some_large_computation + +let _ = + fun (x : int) + (x : int) + (x : int) + (x : int) + (x : int) + (x : int) + (x : int) + : + fooooooooooooooooooooooooooo foooooooooooooo foooooooooo -> + some_large_computation + +let () = + fun x : int -> + fun r : int -> + fun u -> + foooooooooooooooooooooooooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooooooooooooooooooooooooo + +let to_loc_trace + ?(desc_of_source = + fun source -> + let callsite = Source.call_site source in + Format.asprintf + "return from %a" + Typ.Procname.pp + (CallSite.pname callsite)) ?(source_should_nest = fun _ -> true) + ?(desc_of_sink = + fun sink -> + let callsite = Sink.call_site sink in + Format.asprintf "call to %a" Typ.Procname.pp (CallSite.pname callsite)) + ?(sink_should_nest = fun _ -> true) (passthroughs, sources, sinks) = + () + +let translate_captured + { + Clang_ast_t.lci_captured_var; + lci_init_captured_vardecl; + lci_capture_this; + lci_capture_kind; + } ((trans_results_acc, captured_vars_acc) as acc) = + () + +let f ssssssssss = + String.fold ssssssssss ~init:innnnnnnnnnit ~f:(fun accuuuuuuuuuum -> function + | '0' -> g accuuuuuuuuuum + | '1' -> h accuuuuuuuuuum + | _ -> i accuuuuuuuuuum) + +let f ssssssssss = + String.fold ssssssssss ~init:innnnnnnnnnit ~f:(function + | '0' -> g accuuuuuuuuuum + | '1' -> h accuuuuuuuuuum + | _ -> i accuuuuuuuuuum) + +let f _ = + let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in + fun x -> + let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in + x + +let f _ = + let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in + (* foo *) + fun x -> + let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in + x + +let space_break = + (* a stack is useless here, this would require adding a unit parameter *) + with_pp (fun fs -> + Box_debug.space_break fs; + Format_.pp_print_space fs ()) + +let _ = + (fun k -> + let _ = 42 in + ()) + @@ () + +let _ = + let _ = () in + fun (context : Context.t) + ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t) + -> + let _ = () in + () + +class traverse_labels h = + object + method statement = + function + | Labelled_statement (L l, (s, _)) -> + let m = {<ldepth = ldepth + 1>} in + Hashtbl.add h l ldepth; + m#statement s + | s -> super#statement s + end diff --git a/test/passing/refs.default/fun_decl.ml.ref b/test/passing/refs.default/fun_decl.ml.ref new file mode 100644 index 0000000000..47b782e429 --- /dev/null +++ b/test/passing/refs.default/fun_decl.ml.ref @@ -0,0 +1,97 @@ +let _ = fun (x : int) : int -> some_large_computation +let _ = fun (x : int) : int -> (some_large_computation : int) +let fooo = List.foooo ~f:(fun foooo foooo : bool -> foooooooooooooooooooooo) + +let _ = + fun (x : int) (x : int) (x : int) (x : int) (x : int) : + fooooooooooooooooooooooooooo foooooooooooooo foooooooooo -> + some_large_computation + +let _ = + fun (x : int) (x : int) (x : int) (x : int) (x : int) (x : int) (x : int) : + fooooooooooooooooooooooooooo foooooooooooooo foooooooooo -> + some_large_computation + +let () = + fun x : int -> + fun r : int -> + fun u -> + foooooooooooooooooooooooooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooooooooooooooooooooooooo + +let to_loc_trace + ?(desc_of_source = + fun source -> + let callsite = Source.call_site source in + Format.asprintf "return from %a" Typ.Procname.pp + (CallSite.pname callsite)) ?(source_should_nest = fun _ -> true) + ?(desc_of_sink = + fun sink -> + let callsite = Sink.call_site sink in + Format.asprintf "call to %a" Typ.Procname.pp (CallSite.pname callsite)) + ?(sink_should_nest = fun _ -> true) (passthroughs, sources, sinks) = + () + +let translate_captured + { + Clang_ast_t.lci_captured_var; + lci_init_captured_vardecl; + lci_capture_this; + lci_capture_kind; + } ((trans_results_acc, captured_vars_acc) as acc) = + () + +let f ssssssssss = + String.fold ssssssssss ~init:innnnnnnnnnit ~f:(fun accuuuuuuuuuum -> function + | '0' -> g accuuuuuuuuuum + | '1' -> h accuuuuuuuuuum + | _ -> i accuuuuuuuuuum) + +let f ssssssssss = + String.fold ssssssssss ~init:innnnnnnnnnit ~f:(function + | '0' -> g accuuuuuuuuuum + | '1' -> h accuuuuuuuuuum + | _ -> i accuuuuuuuuuum) + +let f _ = + let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in + fun x -> + let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in + x + +let f _ = + let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in + (* foo *) + fun x -> + let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in + x + +let space_break = + (* a stack is useless here, this would require adding a unit parameter *) + with_pp (fun fs -> + Box_debug.space_break fs; + Format_.pp_print_space fs ()) + +let _ = + (fun k -> + let _ = 42 in + ()) + @@ () + +let _ = + let _ = () in + fun (context : Context.t) + ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t) -> + let _ = () in + () + +class traverse_labels h = + object + method statement = + function + | Labelled_statement (L l, (s, _)) -> + let m = {<ldepth = ldepth + 1>} in + Hashtbl.add h l ldepth; + m#statement s + | s -> super#statement s + end diff --git a/test/passing/tests/fun_function.ml.ref b/test/passing/refs.default/fun_function.ml.ref similarity index 89% rename from test/passing/tests/fun_function.ml.ref rename to test/passing/refs.default/fun_function.ml.ref index a8a2a84c00..167cca078e 100644 --- a/test/passing/tests/fun_function.ml.ref +++ b/test/passing/refs.default/fun_function.ml.ref @@ -1,26 +1,17 @@ let s = List.fold x ~f:(fun y -> function | Aconstructor avalue -> afunction avalue - | Bconstructor bvalue -> bfunction bvalue ) + | Bconstructor bvalue -> bfunction bvalue) let f _ = (function x -> x + 1) - let f _ = function x -> x + 1 - let f _ = fun _ -> (function x -> x + 1) - let f _ = fun _ -> function x -> x + 1 - let f _ = fun _ -> (function x -> x + 1) - let f _ = fun _ -> function x -> x + 1 - let f _ = fun _ -> fun x -> x + 1 - let f _ = fun _ -> fun x -> x + 1 - let f _ = fun _ -> fun x -> x + 1 - let f _ = fun _ -> fun x -> x + 1 let _ = @@ -109,17 +100,17 @@ open struct let _ = let _ = function | Partial _ -> ( - fun {target} -> + fun { target } -> match target with | Lazy key -> Val_ref.of_key key - | Lazy_loaded {v_ref; _} | Dirty {v_ref; _} -> v_ref ) + | Lazy_loaded { v_ref; _ } | Dirty { v_ref; _ } -> v_ref) in () let _ = function | Partial _ -> ( - fun {target} -> + fun { target } -> match target with | Lazy key -> Val_ref.of_key key - | Lazy_loaded {v_ref; _} | Dirty {v_ref; _} -> v_ref ) + | Lazy_loaded { v_ref; _ } | Dirty { v_ref; _ } -> v_ref) end diff --git a/test/passing/tests/function_indent-never.ml.ref b/test/passing/refs.default/function_indent-never.ml.ref similarity index 80% rename from test/passing/tests/function_indent-never.ml.ref rename to test/passing/refs.default/function_indent-never.ml.ref index 52443ae384..e10cc293c3 100644 --- a/test/passing/tests/function_indent-never.ml.ref +++ b/test/passing/refs.default/function_indent-never.ml.ref @@ -8,13 +8,13 @@ let foooooooo = function let foo = fooooooooo foooooooo ~foooooooo:(function | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo - | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo ) + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo) let foo = fooooooooo foooooooo foooooooo foooooooo foooooooo foooooooo ~foooooooo:(function | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo - | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo ) + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo) let foooooooo = if fooooooooooo then function @@ -25,17 +25,18 @@ let foooooooo = | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo let _ = - { foo= + { + foo = (fun _ -> function | _ -> let _ = 42 in () - | () -> () ) } + | () -> ()); + } let _ = match () with | _ -> ( - f - >>= function + f >>= function | `Fooooooooooooooooooooooooooooooooooooooo -> 1 - | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> 2 ) + | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> 2) diff --git a/test/passing/tests/function_indent.ml.ref b/test/passing/refs.default/function_indent.ml.ref similarity index 80% rename from test/passing/tests/function_indent.ml.ref rename to test/passing/refs.default/function_indent.ml.ref index 6ab531abab..13b1aaa1c5 100644 --- a/test/passing/tests/function_indent.ml.ref +++ b/test/passing/refs.default/function_indent.ml.ref @@ -8,13 +8,13 @@ let foooooooo = function let foo = fooooooooo foooooooo ~foooooooo:(function | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo - | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo ) + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo) let foo = fooooooooo foooooooo foooooooo foooooooo foooooooo foooooooo ~foooooooo:(function | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo - | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo ) + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo) let foooooooo = if fooooooooooo then function @@ -25,17 +25,18 @@ let foooooooo = | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo let _ = - { foo= + { + foo = (fun _ -> function | _ -> let _ = 42 in () - | () -> () ) } + | () -> ()); + } let _ = match () with | _ -> ( - f - >>= function + f >>= function | `Fooooooooooooooooooooooooooooooooooooooo -> 1 - | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> 2 ) + | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> 2) diff --git a/test/passing/refs.default/functor.ml.err b/test/passing/refs.default/functor.ml.err new file mode 100644 index 0000000000..43dec49014 --- /dev/null +++ b/test/passing/refs.default/functor.ml.err @@ -0,0 +1,2 @@ +Warning: functor.ml:56 exceeds the margin +Warning: functor.ml:71 exceeds the margin diff --git a/test/passing/refs.default/functor.ml.ref b/test/passing/refs.default/functor.ml.ref new file mode 100644 index 0000000000..80e2d01eae --- /dev/null +++ b/test/passing/refs.default/functor.ml.ref @@ -0,0 +1,91 @@ +module type S = functor () -> sig end +module type S = functor () () -> sig end +module type M = functor () -> sig end +module type M = functor (S : S) -> sig end +module type M = functor (S : S) (T : T) -> sig end +module type M = functor (S : S) (T : T) -> U +module type M = functor (S : S) () -> sig end + +module type M = functor + (SSSSS : SSSSSSSSSSSSSS) + (TTTTT : TTTTTTTTTTTTTTTT) + -> sig + val t1 : a + val t2 : b +end + +module M : functor () -> sig end = functor () -> struct end +module M = (functor (S : S) -> struct end) (S) +module M = (functor (S : S) (T : T) -> struct end) (S) (T) +module M = (functor (S : S) (T : T) -> struct end : U) (S) (T) +module M = (functor (S : S) () -> struct end : U) (S) (T) +module M = (functor (S : S) (T : T) -> (struct end : U)) (S) (T) +module rec A (S : S) = S + +module type S = sig + module rec A : functor (S : S) -> S +end + +module M = + (functor + (SSSSS : sssssSSSSSSSSSSSSSS) + (TTTTT : TTTTTTTTTTTTTTTTTTTTT) + -> + struct + let x = 2 + let y = 3 + end) + (S) + (T) + +module type Module_type_fail = sig + include S + module F : functor (_ : T) -> sig end + include S +end + +module type KV_MAKER = functor (G : Irmin_git.G) (C : Irmin.Contents.S) -> + S + with type key = string list + and type step = string + and type contents = C.t + and type branch = string + and module Git = G + +module Make + (TT : TableFormat.TABLES) + (IT : InspectionTableFormat.TABLES__________________________________________) + (ET : + EngineTypes.TABLE + with type terminal = int + and type nonterminal = int + and type semantic_value = Obj.t) + (E : sig + type 'a env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env + end) = +struct + type t = t +end + +module Make + (TT : TableFormat.TABLES) + (IT : InspectionTableFormat.TABLES__________________________________________) = +struct + type t = t +end + +(* Long syntax should be preserved *) +module M = functor (_ : S) -> struct end +module M (_ : S) = struct end +module M : functor (_ : S) -> S' = functor (_ : S) -> struct end + +module type SETFUNCTOR = (Elt : ORDERED_TYPE) -> sig end + +module WrongSet : (Elt : ORDERED_TYPE) -> SET = Set +module M : (A : S) (B : S) -> S = N +module M : (A : S) (B : S) -> S = N +module M : functor (A : S) -> (B : S) -> S = N +module M : functor (A : S) (B : S) -> S = N +module M : functor (A : S) (B : S) -> S = N +module M : functor (A : S) (B : S) -> S = N +module M : (A : S) -> functor (B : S) -> S = N diff --git a/test/passing/refs.default/functor.mli.ref b/test/passing/refs.default/functor.mli.ref new file mode 100644 index 0000000000..a2ae6a583a --- /dev/null +++ b/test/passing/refs.default/functor.mli.ref @@ -0,0 +1,3 @@ +module F (* test *) (M : sig + type t +end) : S diff --git a/test/passing/refs.default/funsig.ml.ref b/test/passing/refs.default/funsig.ml.ref new file mode 100644 index 0000000000..402ba0c154 --- /dev/null +++ b/test/passing/refs.default/funsig.ml.ref @@ -0,0 +1,71 @@ +val fffffffff : aaaaaa -> bbbbbbbbbb ccccccccc -> dddd +val fffffffff : aaaaaa -> bbbbbbbbbb ccccccccc -> dddd -> dddd -> dddd -> dddd + +val fffffffff : + aaaaaa -> (bbbbbbbbbb ccccccccc -> int) -> bbbbbbbbbb ccccccccc -> dddd + +val fffffffff : + eeee:('a, 'b) aaaaaa -> + (bbbbbbbbbb ccccccccc -> int) -> + bbbbbbbbbb ccccccccc -> + dddd -> + dddd + +val m : (module S with type t = t) + +val f : + ( 'aaaaaaaaaaaaaaaaaaaa, + xxxxxxxxxxxxxxxxxxxxxxxxx -> + yyyyyyyyyyyyyyyyyyyyyyyyy -> + bbbbbbbbbbbbbbbbbbbb, + 'dddddddddddddddddddd ) + s + +type t = + | Cstr of + (xxxxxxxxxxxxxxxxxxxxxxxxx -> + yyyyyyyyyyyyyyyyyyyyyyyyy -> + aaaaaaaaaaaaaaaaaaaa) + * bbbbbbbbbbbbbbbbbbbb + +type t = + | Cstr of + aaaaaaaaaaaaaaaaaaaa + * (xxxxxxxxxxxxxxxxxxxxxxxxx -> + yyyyyyyyyyyyyyyyyyyyyyyyy -> + bbbbbbbbbbbbbbbbbbbb) + * cccccccccccccccccccc + +type ('aaaa, 'bbbb, 'cccc) t = + llll:('aaaa, 'bbbb, 'cccc) s -> dddddd list -> 'aaaa * 'cccc -> 'bbbb uuuuu + +external ident : a -> b -> c -> d = "something" +external ident : a -> b -> c -> d = "something" "else" +val ident : a -> b -> c -> d +val ident : arg1_is_loooooooooooooooooooooooooooooooong -> arg2 -> arg3 -> arg4 + +external ident : + arg1_is_loooooooooooooooooooooooooooooooong -> arg2 -> arg3 -> arg4 + = "something" "else" + +type t = { field1 : a -> b -> c; field2 : int; field3 : a -> b -> c -> d -> e } + +type t = { + field1 : a -> b -> c; + field2 : int; + field3 : a -> b -> c -> d -> e -> f; +} + +type t = { + field1 : a -> b -> c; + field2 : int; + field3 : + a_is_loooooooooooooooooooooooooooooooong -> + b_is_loooooooooooooooooooooooooooooooong -> + c -> + d -> + e; + field4 : a_is_loooooooooooooooooooong -> b_is_loooooooooong -> c -> d -> e; + field5 : + a loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong typ; +} diff --git a/test/passing/refs.default/gadt.ml.ref b/test/passing/refs.default/gadt.ml.ref new file mode 100644 index 0000000000..985617da15 --- /dev/null +++ b/test/passing/refs.default/gadt.ml.ref @@ -0,0 +1,15 @@ +type t = A : t +type t = A : t * 'b -> t + +type (_, _, _, _, _) gadt = + | SomeLongName : + ('a, 'b, long_name * long_name2, 't, 'u) gadt * ('b, 'c, 'v, 'u, 'k) gadt2 + -> ('a, 'c, long_name * 'k, 't, 'v) gadt + | AnEvenLongerName : + ('a, 'b, long_name * long_name2, 't, 'u) gadt * ('b, 'c, 'v, 'u, 'k) gadt2 + -> ('a, 'c, long_name * 'k, 't, 'v) gadt + +type _ t = .. +type _ t += A : int | B : int -> int +type t = A : (int -> int) -> int +type _ g = MkG : 'a. 'a g diff --git a/test/passing/refs.default/generative.ml.ref b/test/passing/refs.default/generative.ml.ref new file mode 100644 index 0000000000..676a0bda6b --- /dev/null +++ b/test/passing/refs.default/generative.ml.ref @@ -0,0 +1,9 @@ +module Generative () = struct end +module M = Generative () +module M = String_id (M) () +module F2 : functor () -> sig end = F1 +module F2 : functor () () -> sig end = F1 +module F2 : (*xx*) ( (*yy*) ) (*zz*) -> sig end = F1 +module F2 : () -> functor [@attr] () () -> sig end = F1 +module F2 : () -> functor () () -> () -> sig end = F1 +module F2 : () () () -> functor () () -> () -> sig end = F1 diff --git a/test/passing/refs.default/hash_bang.ml.ref b/test/passing/refs.default/hash_bang.ml.ref new file mode 100644 index 0000000000..c5284310b4 --- /dev/null +++ b/test/passing/refs.default/hash_bang.ml.ref @@ -0,0 +1,3 @@ +#!/usr/bin/env ocaml + +let _ = sprintf "[%s]" s diff --git a/test/passing/refs.default/hash_types.ml.ref b/test/passing/refs.default/hash_types.ml.ref new file mode 100644 index 0000000000..a2f551ab00 --- /dev/null +++ b/test/passing/refs.default/hash_types.ml.ref @@ -0,0 +1,13 @@ +module F (X : sig + type t +end) = +struct + class type ['a] c = object + method m : 'a -> X.t + end +end + +class ['a] c = + object + constraint 'a = 'a #F(Int).c + end diff --git a/test/passing/refs.default/holes.ml.ref b/test/passing/refs.default/holes.ml.ref new file mode 100644 index 0000000000..f7eb3fabce --- /dev/null +++ b/test/passing/refs.default/holes.ml.ref @@ -0,0 +1,11 @@ +let () = _ + +(** doc *) +let () = (* A *) _ (* B *) [@attr] (* C *) + +module M = _ + +module M = (* A *) _ (* B *) [@attr] +(** doc *) (* C *) + +module M = _ (_) (_) diff --git a/test/passing/refs.default/ifand.ml.ref b/test/passing/refs.default/ifand.ml.ref new file mode 100644 index 0000000000..1424110fdb --- /dev/null +++ b/test/passing/refs.default/ifand.ml.ref @@ -0,0 +1,2 @@ +let _ = if cond1 && cond2 then _ +let _ = function _ when x = 2 && y = 3 -> if a = b || (b = c && c = d) then _ diff --git a/test/passing/refs.default/index_op.ml.ref b/test/passing/refs.default/index_op.ml.ref new file mode 100644 index 0000000000..146defa993 --- /dev/null +++ b/test/passing/refs.default/index_op.ml.ref @@ -0,0 +1,146 @@ +let ( .?[] ) = Hashtbl.find_opt +let ( .@[] ) = Hashtbl.find +let ( .@[]<- ) = Hashtbl.add +let ( .@{} ) = Hashtbl.find +let ( .@{}<- ) = Hashtbl.add +let ( .@() ) = Hashtbl.find +let ( .@()<- ) = Hashtbl.add +let h = Hashtbl.create 17;; + +h.@("One") <- 1; +assert (h.@{"One"} = 1); +print_int h.@{"One"}; +assert (h.?["Two"] = None) + +(* from GPR#1392 *) +let ( #? ) x y = (x, y) +let ( .%() ) x y = x.(y) +let x = [| 0 |] +let _ = 1#?x.(0) +let _ = 1#?x.%(0);; + +a.[b].[c];; +a.[b.[c]].[c];; +a.b.c + +let _ = s.{1} +let _ = s.{1} <- 1 +let _ = s.{1, 2} +let _ = s.{1, 2} <- 1 +let _ = s.{1, 2, 3} +let _ = s.{1, 2, 3} <- 1 +let _ = s.{1, 2, 3, 4} +let _ = s.{1, 2, 3, 4} <- 1 +let _ = Bigarray.Genarray.get s 1 [||] +let _ = Bigarray.Genarray.get s [| 1 |] +let _ = Bigarray.Genarray.get s [| 1; 2 |] +let _ = Bigarray.Genarray.get s [| 1; 2; 3 |] +let _ = s.{1, 2, 3, 4} +let _ = Bigarray.Genarray.set s [||] 1 +let _ = Bigarray.Genarray.set s [| 1 |] 1 +let _ = Bigarray.Genarray.set s [| 1; 2 |] 1 +let _ = Bigarray.Genarray.set s [| 1; 2; 3 |] 1 +let _ = s.{1, 2, 3, 4} <- 1 + +let () = + let m = Mat.zeros 5 5 in + m.Mat.${[ [ 2 ]; [ 5 ] ]} |> ignore; + let open Mat in + m.${[ [ 2 ]; [ 5 ] ]} |> ignore + +let _ = (x.*{y, z} <- w) @ [] +let _ = (x.{y, z} <- w) @ [] +let _ = (x.*(y) <- z) @ [] +let _ = (x.*(y) <- z) := [] +let _ = ((x.*(y) <- z), []) + +let _ = + x.*(y) <- z; + [] + +let _ = (x.(y) <- z) @ [] +let _ = (x.(y) <- z) := [] +let _ = ((x.(y) <- z), []) + +let _ = + x.(y) <- z; + [] + +let _ = (x.y <- z) @ [] +let _ = (x.y <- z) := [] +let _ = ((x.y <- z), []) + +let _ = + x.y <- z; + [] + +let _ = x.(y) <- (z.(w) <- u) +let _ = x.foo#m + +class free = + object (m : 'test) + method get_def = m#state.def + end + +(* With path *) +let _ = + a.A.B.*(b); + a.A.B.*(b) <- c + +let _ = + a.*((a; + b)) + +let _ = a.*([| a; b |]) + +(* Avoid unecessary parentheses *) +let _ = + match a with + | A -> a.*(match b with B -> b) + | B -> a.*(match b with B -> b) <- D + | C -> () + +let _ = if a then a.*(if a then b) else c + +(* Parentheses needed *) +let _ = + a.*{(a; + b)} + +let _ = + a.{a; + b} + +let _ = a.{a, b} + +(* Integers on the left of indexing operators must be surrounded by + parentheses *) +let _ = (0).*(0) + +(* Integers with suffix and floats are fine *) +let _ = 0l.*(0) +let _ = 0..*(0) +let _ = 0.2.*(0) +let _ = 2e5.*(0) +let _ = 2e-2.*(0) +let _ = (String.get [@bar]) filename (len - 1) = 'i' +let _ = "hello world".[-8] +let _ = String.get "hello world" (-8) +let _ = String.unsafe_get "hello world" (-8) +let _ = [||].(-8) +let _ = Array.get [||] (-8) +let _ = Array.unsafe_get [||] (-8) +let _ = Bigarray.Genarray.get x [||] (-8) +let _ = Bigarray.Genarray.unsafe_get x [||] (-8) +let _ = [%p (Some).(tickers)] +let _ = [%p (Explicit).(0 / 2)] +let _ = [%p Some.(tickers)] +let _ = [%p Explicit.(0 / 2)] +let _ = (Some).(tickers) +let _ = (Explicit).(0 / 2) +let _ = Some.(tickers) +let _ = Explicit.(0 / 2) +let _ = f (Some).(tickers) +let _ = f (Explicit).(0 / 2) +let _ = f Some.(tickers) +let _ = f Explicit.(0 / 2) diff --git a/test/passing/refs.default/indicate_multiline_delimiters-cosl.ml.ref b/test/passing/refs.default/indicate_multiline_delimiters-cosl.ml.ref new file mode 100644 index 0000000000..692f755cb2 --- /dev/null +++ b/test/passing/refs.default/indicate_multiline_delimiters-cosl.ml.ref @@ -0,0 +1,63 @@ +let compare = function + | Eq -> ( = ) + | Neq -> ( <> ) + | Lt -> ( < ) [@attr] + | Le -> ( <= ) + | Gt -> ( > ) + | Ge -> ( >= ) + +let raise fmt = + Fmt.kstr + (fun error_message (result : _ result) -> + match result with Ok v -> v | Error `Oh_no -> invalid_arg error_message + ) + fmt + +let raise fmt = + Fmt.kstr + (fun error_message aaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb -> + invalid_arg error_message + ) + fmt + +let raise fmt = + Fmt.kstr + (fun error_message (result : _ result) -> + match result with Ok v -> v | Error `Oh_no -> invalid_arg error_message + ) + fmt + +let raise fmt = + Fmt.kstr + (fun error_message aaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb -> + invalid_arg error_message + ) + fmt + +let contrived = + List.map + ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + ) + l + +let contrived = + List.map l ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + ) + +let x = + match y with + | Empty | Leaf _ -> assert false + | Node + ( { + left = lr_left; + key = _; + value = fooooooo; + height = _; + right = lr_right; + } as lr_node + ) -> + left_node.right <- lr_left; + root_node.left <- lr_right; + lr_node.right <- tree diff --git a/test/passing/refs.default/indicate_multiline_delimiters-space.ml.ref b/test/passing/refs.default/indicate_multiline_delimiters-space.ml.ref new file mode 100644 index 0000000000..f6909f327c --- /dev/null +++ b/test/passing/refs.default/indicate_multiline_delimiters-space.ml.ref @@ -0,0 +1,56 @@ +let compare = function + | Eq -> ( = ) + | Neq -> ( <> ) + | Lt -> ( < ) [@attr] + | Le -> ( <= ) + | Gt -> ( > ) + | Ge -> ( >= ) + +let raise fmt = + Fmt.kstr + (fun error_message (result : _ result) -> + match result with Ok v -> v | Error `Oh_no -> invalid_arg error_message ) + fmt + +let raise fmt = + Fmt.kstr + (fun error_message aaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb -> + invalid_arg error_message ) + fmt + +let raise fmt = + Fmt.kstr + (fun error_message (result : _ result) -> + match result with Ok v -> v | Error `Oh_no -> invalid_arg error_message ) + fmt + +let raise fmt = + Fmt.kstr + (fun error_message aaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb -> + invalid_arg error_message ) + fmt + +let contrived = + List.map + ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa ) + l + +let contrived = + List.map l ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa ) + +let x = + match y with + | Empty | Leaf _ -> assert false + | Node + ( { + left = lr_left; + key = _; + value = fooooooo; + height = _; + right = lr_right; + } as lr_node ) -> + left_node.right <- lr_left; + root_node.left <- lr_right; + lr_node.right <- tree diff --git a/test/passing/refs.default/indicate_multiline_delimiters.ml.ref b/test/passing/refs.default/indicate_multiline_delimiters.ml.ref new file mode 100644 index 0000000000..4793c895c2 --- /dev/null +++ b/test/passing/refs.default/indicate_multiline_delimiters.ml.ref @@ -0,0 +1,56 @@ +let compare = function + | Eq -> ( = ) + | Neq -> ( <> ) + | Lt -> ( < ) [@attr] + | Le -> ( <= ) + | Gt -> ( > ) + | Ge -> ( >= ) + +let raise fmt = + Fmt.kstr + (fun error_message (result : _ result) -> + match result with Ok v -> v | Error `Oh_no -> invalid_arg error_message) + fmt + +let raise fmt = + Fmt.kstr + (fun error_message aaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb -> + invalid_arg error_message) + fmt + +let raise fmt = + Fmt.kstr + (fun error_message (result : _ result) -> + match result with Ok v -> v | Error `Oh_no -> invalid_arg error_message) + fmt + +let raise fmt = + Fmt.kstr + (fun error_message aaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb -> + invalid_arg error_message) + fmt + +let contrived = + List.map + ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) + l + +let contrived = + List.map l ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) + +let x = + match y with + | Empty | Leaf _ -> assert false + | Node + ({ + left = lr_left; + key = _; + value = fooooooo; + height = _; + right = lr_right; + } as lr_node) -> + left_node.right <- lr_left; + root_node.left <- lr_right; + lr_node.right <- tree diff --git a/test/passing/refs.default/infix_arg_grouping.ml.err b/test/passing/refs.default/infix_arg_grouping.ml.err new file mode 100644 index 0000000000..38a80cf324 --- /dev/null +++ b/test/passing/refs.default/infix_arg_grouping.ml.err @@ -0,0 +1 @@ +Warning: infix_arg_grouping.ml:73 exceeds the margin diff --git a/test/passing/refs.default/infix_arg_grouping.ml.ref b/test/passing/refs.default/infix_arg_grouping.ml.ref new file mode 100644 index 0000000000..6b9207f4f1 --- /dev/null +++ b/test/passing/refs.default/infix_arg_grouping.ml.ref @@ -0,0 +1,145 @@ +vbox 1 + (str (Sexp.to_string_hum (Itv.sexp_of_t root)) + $ wrap_if (not (List.is_empty children)) "@,{" " }" (dump_ tree children)) +;; + +user_error + ("version mismatch: .ocamlformat requested " ^ value ^ " but version is " + ^ Version.version) +;; + +hvbox 1 + (str "\"" + $ list_pn lines (fun ?prev curr ?next -> + let drop = function ' ' -> true | _ -> false in + let line = + if Option.is_none prev then curr else String.lstrip ~drop curr + in + fmt_line line + $ opt next (fun next -> + let spc = + match String.lfindi next ~f:(fun _ c -> not (drop c)) with + | Some 0 -> "" + | Some i -> escape_string (String.sub next 0 i) + | None -> escape_string next + in + fmt "\\n" + $ fmt_if_k + (not (String.is_empty next)) + (str spc $ pre_break 0 "\\" 0))) + $ str "\"" $ Option.call ~f:epi) +;; + +hvbox 0 + (wrap_fits_breaks "<" ">" + (list fields "@ ; " (function + | Otag (lab_loc, attrs, typ) -> + (* label loc * attributes * core_type -> object_field *) + let doc, atrs = doc_atrs attrs in + let fmt_cmts = Cmts.fmt c lab_loc.loc in + fmt_cmts + @@ hvbox 4 + (hvbox 2 + (Cmts.fmt c lab_loc.loc @@ str lab_loc.txt + $ fmt ":@ " + $ fmt_core_type c (sub_typ ~ctx typ)) + $ fmt_docstring c ~pro:(fmt "@;<2 0>") doc + $ fmt_attributes c (fmt " ") ~key:"@" atrs (fmt "")) + | Oinherit typ -> fmt_core_type c (sub_typ ~ctx typ)) + $ fmt_if + Poly.(closedness = Open) + (match fields with [] -> "@ .. " | _ -> "@ ; .. "))) +;; + +hvbox 0 + (fmt "functor@ " + $ wrap "(" ")" + (str txt + $ opt mt (fun _ -> + fmt "@ : " $ Option.call ~f:pro_t $ psp_t $ fmt "@;<1 2>" $ bdy_t + $ esp_t $ Option.call ~f:epi_t)) + $ fmt " ->@ " $ Option.call ~f:pro_e $ psp_e $ bdy_e $ esp_e + $ Option.call ~f:epi_e) + +let to_json { integers; floats; strings } = + `Assoc + [ + ("int", yojson_of_integers integers); + ("double", yojson_of_floats floats); + ("normal", yojson_of_strings strings); + ] + |> Yojson.Basic.to_string + +let rename (us, q) sub = + ( Var.Set.union (Var.Set.diff us (Var.Subst.domain sub)) (Var.Subst.range sub), + rename_q q sub ) + |> check invariant + +let _ = + List.map ~f + ([ + aaaaaaaaaaaaaaa; + bbbbbbbbbbbbbbb; + ccccccccccccccc; + ddddddddddddddd; + eeeeeeeeeeeeeee; + ] + @ l) + +let sigma_seed = + create_seed_vars + ((* formals already there plus new ones *) + prop.Prop.sigma @ sigma_new_formals) +;; + +match + "\"" ^ line ^ " \"" + |> + (* split by whitespace *) + Str.split (Str.regexp_string "\" \"") +with +| prog :: args -> fooooooooooooooooooooo + +let () = + (* Open the repo *) + initialise + >>= + (* Perform a subsequent action *) + subsequent_action + >|= + (* Keep going... *) + another_action + |> fun t -> + (* And finally do this *) + final_action t + +let () = + (* Open the repo *) + initialise + (* Perform a subsequent action *) + >>= subsequent_action + (* Keep going... *) + >|= another_action + (* And finally do this *) + |> fun t -> final_action t + +let _ = + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + - + (* ___________________________________ *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + +let _ = + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + >= + (* ___________________________________ *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + +let _ = + List.filter (fun s -> + (* 3.1. the sid of the authenticated user *) + foooooooooooooooooooooooooooooo + || + (* 3.2. any sids of the group that authenticated the user *) + (* TODO: better to look up the membership closure *) + fooooooooooooooooooooooooooo) diff --git a/test/passing/refs.default/infix_bind-break.ml.ref b/test/passing/refs.default/infix_bind-break.ml.ref new file mode 100644 index 0000000000..afa62e8966 --- /dev/null +++ b/test/passing/refs.default/infix_bind-break.ml.ref @@ -0,0 +1,240 @@ +f x +>>= fun y -> +g y +>>= fun () -> +f x >>= fun y -> g y >>= fun () -> f x >>= fun y -> g y >>= fun () -> y () +;; + +f x +>>= function +| A -> ( + g y + >>= fun () -> + f x + >>= fun y -> + g y >>= function x -> ( f x >>= fun y -> g y >>= function _ -> y ())) +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> fun x -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> fun xxxxxxxxx xxxxxxxxxxxxx -> x;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee +|> fun xxxxxxxx xxxxxxxxx xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee +|> fun xxxxxxxxxxxxx -> xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee +|> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function x -> x;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> function xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> function x -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function x -> x;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> function xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function xxxxxxxxx, xxxxxxxxxxxxx -> x;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee +|> function xxxxxxxx, xxxxxxxxx, xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee +|> function xxxxxxxxxxxxx -> xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee +|> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx + +let parens = + match body with + | { pexp_desc = Pexp_function cs; pexp_attributes; pexp_loc } -> + update_config_maybe_disabled c pexp_loc pexp_attributes + @@ fun c -> + fmt "@ " + $ Cmts.fmt c.cmts pexp_loc + (wrap_if parens "(" ")" + (fmt "function" $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box $ fmt "@ " $ fmt_cases c ctx cs)) + | _ -> close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody + +let parens = + match body with + | { pexp_desc = Pexp_function cs; pexp_attributes; pexp_loc } -> ( + update_config_maybe_disabled c pexp_loc pexp_attributes + @@ function + | _ -> + fmt "@ " + $ Cmts.fmt c.cmts pexp_loc + (wrap_if parens "(" ")" + (fmt "function" $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box $ fmt "@ " $ fmt_cases c ctx cs)) + | _ -> + close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody) + +let end_gen_implementation ?toplevel ~ppf_dump (clambda : clambda_and_constants) + = + Emit.begin_assembly (); + (clambda + ++ Profile.record "cmm" (Cmmgen.compunit ~ppf_dump) + ++ Profile.record "compile_phrases" (List.iter (compile_phrase ~ppf_dump)) + ++ fun () -> ()); + fooooooooooooooo + +let foo = + (* get the tree origin *) + get_store_tree s + >>= function + | None -> f t >|= fun x -> Ok x (* no transaction is needed *) + | Some (origin, old_tree) -> + let batch = { repo; tree = old_tree; origin } in + let b = Batch batch in + foo + +let _ = foo >>= function[@warning "-4"] A -> false | B -> true + +let _ = + foo + >>= function[@warning "-4"] + | Afoooooooooooooooooo fooooooooo -> false + | Bfoooooooooooooooooooooo fooooooooo -> true + +let _ = foo >>= fun [@warning "-4"] x -> fooooooooooooooooooooooo + +let _ = + foo + >>= fun [@warning "-4"] x y -> + fooooooooooooooooooooooo fooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooooooo + +let _ = + foo + >>= function(* foo before *) [@warning "-4"] (* foo after *) + | Afoooooooooooooooooo fooooooooo -> false + | Bfoooooooooooooooooooooo fooooooooo -> true + +let _ = + foo + >>= fun (* foo before *) [@warning "-4"] (* foo after *) x -> + fooooooooooooooooooooooo + +let f = + Ok () + >>= + (* *) + fun _ -> Ok () + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () + >>= + (* *) + fun _ -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +let f = + Ok () + >>= + (* *) + function Foo -> Ok () + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () + >>= + (* *) + function Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + fun foooooo fooooo foooo foooooo -> + Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + function Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +(** The tests below are testing a dropped comment with + `--no-break-infix-before-func` *) + +let _ = x |> fun y -> y (* *) +let _ = x |> function y -> y (* *) +let _ = match () with A -> ( x |> function y -> y (* *)) | B -> () +let _ = x |> function y -> ( function _ -> y (* A *)) (* B *) +let _ = () (* This is needed here to avoid the comment above from moving *) + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k + +let default = + command##hasPermission#=(fun ctx -> foooooooooooooooooo fooooooooooo); + command##hasPermission#=(fun ctx -> + foooooooooooooooooo fooooooooooo foooooo fooooooooo + foooooooooo); + foo + +let _ = ( let* ) x (fun y -> z) +let _ = ( let* ) x (function y -> z) +let _ = f (( let* ) x (fun y -> z)) +let _ = f (( let* ) x (function y -> z)) +let _ = (x >>= fun () -> ()) [@a] +let _ = ( >>= ) [@attr] +let _ = f (( >>= ) [@attr]);; + +( >>= ) [@attr] diff --git a/test/passing/refs.default/infix_bind-fit_or_vertical-break.ml.ref b/test/passing/refs.default/infix_bind-fit_or_vertical-break.ml.ref new file mode 100644 index 0000000000..ad8851b92f --- /dev/null +++ b/test/passing/refs.default/infix_bind-fit_or_vertical-break.ml.ref @@ -0,0 +1,246 @@ +f x +>>= fun y -> +g y +>>= fun () -> +f x >>= fun y -> g y >>= fun () -> f x >>= fun y -> g y >>= fun () -> y () +;; + +f x +>>= function +| A -> ( + g y + >>= fun () -> + f x + >>= fun y -> + g y >>= function x -> ( f x >>= fun y -> g y >>= function _ -> y ())) +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> fun x -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> fun xxxxxxxxx xxxxxxxxxxxxx -> x;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee +|> fun xxxxxxxx xxxxxxxxx xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee +|> fun xxxxxxxxxxxxx -> xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee +|> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function x -> x;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> function xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> function x -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function x -> x;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> function xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function xxxxxxxxx, xxxxxxxxxxxxx -> x;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee +|> function xxxxxxxx, xxxxxxxxx, xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee +|> function xxxxxxxxxxxxx -> xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee +|> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx + +let parens = + match body with + | { pexp_desc = Pexp_function cs; pexp_attributes; pexp_loc } -> + update_config_maybe_disabled c pexp_loc pexp_attributes + @@ fun c -> + fmt "@ " + $ Cmts.fmt c.cmts pexp_loc + (wrap_if parens "(" ")" + (fmt "function" + $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box + $ fmt "@ " + $ fmt_cases c ctx cs)) + | _ -> close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody + +let parens = + match body with + | { pexp_desc = Pexp_function cs; pexp_attributes; pexp_loc } -> ( + update_config_maybe_disabled c pexp_loc pexp_attributes + @@ function + | _ -> + fmt "@ " + $ Cmts.fmt c.cmts pexp_loc + (wrap_if parens "(" ")" + (fmt "function" + $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box + $ fmt "@ " + $ fmt_cases c ctx cs)) + | _ -> + close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody) + +let end_gen_implementation ?toplevel ~ppf_dump (clambda : clambda_and_constants) + = + Emit.begin_assembly (); + (clambda + ++ Profile.record "cmm" (Cmmgen.compunit ~ppf_dump) + ++ Profile.record "compile_phrases" (List.iter (compile_phrase ~ppf_dump)) + ++ fun () -> ()); + fooooooooooooooo + +let foo = + (* get the tree origin *) + get_store_tree s + >>= function + | None -> f t >|= fun x -> Ok x (* no transaction is needed *) + | Some (origin, old_tree) -> + let batch = { repo; tree = old_tree; origin } in + let b = Batch batch in + foo + +let _ = foo >>= function[@warning "-4"] A -> false | B -> true + +let _ = + foo + >>= function[@warning "-4"] + | Afoooooooooooooooooo fooooooooo -> false + | Bfoooooooooooooooooooooo fooooooooo -> true + +let _ = foo >>= fun [@warning "-4"] x -> fooooooooooooooooooooooo + +let _ = + foo + >>= fun [@warning "-4"] x y -> + fooooooooooooooooooooooo fooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooooooo + +let _ = + foo + >>= function(* foo before *) [@warning "-4"] (* foo after *) + | Afoooooooooooooooooo fooooooooo -> false + | Bfoooooooooooooooooooooo fooooooooo -> true + +let _ = + foo + >>= fun (* foo before *) [@warning "-4"] (* foo after *) x -> + fooooooooooooooooooooooo + +let f = + Ok () + >>= + (* *) + fun _ -> Ok () + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () + >>= + (* *) + fun _ -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +let f = + Ok () + >>= + (* *) + function Foo -> Ok () + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () + >>= + (* *) + function Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + fun foooooo fooooo foooo foooooo -> + Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + function Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +(** The tests below are testing a dropped comment with + `--no-break-infix-before-func` *) + +let _ = x |> fun y -> y (* *) +let _ = x |> function y -> y (* *) +let _ = match () with A -> ( x |> function y -> y (* *)) | B -> () +let _ = x |> function y -> ( function _ -> y (* A *)) (* B *) +let _ = () (* This is needed here to avoid the comment above from moving *) + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k + +let default = + command##hasPermission#=(fun ctx -> foooooooooooooooooo fooooooooooo); + command##hasPermission#=(fun ctx -> + foooooooooooooooooo fooooooooooo foooooo fooooooooo + foooooooooo); + foo + +let _ = ( let* ) x (fun y -> z) +let _ = ( let* ) x (function y -> z) +let _ = f (( let* ) x (fun y -> z)) +let _ = f (( let* ) x (function y -> z)) +let _ = (x >>= fun () -> ()) [@a] +let _ = ( >>= ) [@attr] +let _ = f (( >>= ) [@attr]);; + +( >>= ) [@attr] diff --git a/test/passing/refs.default/infix_bind-fit_or_vertical.ml.ref b/test/passing/refs.default/infix_bind-fit_or_vertical.ml.ref new file mode 100644 index 0000000000..81cdbfad3d --- /dev/null +++ b/test/passing/refs.default/infix_bind-fit_or_vertical.ml.ref @@ -0,0 +1,228 @@ +f x >>= fun y -> +g y >>= fun () -> +f x >>= fun y -> +g y >>= fun () -> +f x >>= fun y -> +g y >>= fun () -> y () +;; + +f x >>= function +| A -> ( + g y >>= fun () -> + f x >>= fun y -> + g y >>= function + | x -> ( + f x >>= fun y -> + g y >>= function _ -> y ())) +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> fun x -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> fun xxxxxxxxx xxxxxxxxxxxxx -> x;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee +|> fun xxxxxxxx xxxxxxxxx xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> fun xxxxxxxxxxxxx -> +xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee +|> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function x -> x;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function +| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> function +| x -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function x -> x;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function +| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function xxxxxxxxx, xxxxxxxxxxxxx -> x;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee |> function +| xxxxxxxx, xxxxxxxxx, xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function +| xxxxxxxxxxxxx -> xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee |> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx + +let parens = + match body with + | { pexp_desc = Pexp_function cs; pexp_attributes; pexp_loc } -> + update_config_maybe_disabled c pexp_loc pexp_attributes @@ fun c -> + fmt "@ " + $ Cmts.fmt c.cmts pexp_loc + (wrap_if parens "(" ")" + (fmt "function" + $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box + $ fmt "@ " + $ fmt_cases c ctx cs)) + | _ -> close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody + +let parens = + match body with + | { pexp_desc = Pexp_function cs; pexp_attributes; pexp_loc } -> ( + update_config_maybe_disabled c pexp_loc pexp_attributes @@ function + | _ -> + fmt "@ " + $ Cmts.fmt c.cmts pexp_loc + (wrap_if parens "(" ")" + (fmt "function" + $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box + $ fmt "@ " + $ fmt_cases c ctx cs)) + | _ -> + close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody) + +let end_gen_implementation ?toplevel ~ppf_dump (clambda : clambda_and_constants) + = + Emit.begin_assembly (); + ( clambda + ++ Profile.record "cmm" (Cmmgen.compunit ~ppf_dump) + ++ Profile.record "compile_phrases" (List.iter (compile_phrase ~ppf_dump)) + ++ fun () -> () ); + fooooooooooooooo + +let foo = + (* get the tree origin *) + get_store_tree s >>= function + | None -> f t >|= fun x -> Ok x (* no transaction is needed *) + | Some (origin, old_tree) -> + let batch = { repo; tree = old_tree; origin } in + let b = Batch batch in + foo + +let _ = foo >>= function[@warning "-4"] A -> false | B -> true + +let _ = + foo >>= function[@warning "-4"] + | Afoooooooooooooooooo fooooooooo -> false + | Bfoooooooooooooooooooooo fooooooooo -> true + +let _ = foo >>= fun [@warning "-4"] x -> fooooooooooooooooooooooo + +let _ = + foo >>= fun [@warning "-4"] x y -> + fooooooooooooooooooooooo fooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooooooo + +let _ = + foo >>= function(* foo before *) [@warning "-4"] (* foo after *) + | Afoooooooooooooooooo fooooooooo -> false + | Bfoooooooooooooooooooooo fooooooooo -> true + +let _ = + foo >>= fun (* foo before *) [@warning "-4"] (* foo after *) x -> + fooooooooooooooooooooooo + +let f = Ok () >>= (* *) fun _ -> Ok () + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () >>= (* *) fun _ -> + Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +let f = Ok () >>= (* *) function Foo -> Ok () + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () >>= (* *) function + | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + fun foooooo fooooo foooo foooooo -> + Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + function + | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +(** The tests below are testing a dropped comment with + `--no-break-infix-before-func` *) + +let _ = x |> fun y -> y (* *) +let _ = x |> function y -> y (* *) +let _ = match () with A -> ( x |> function y -> y (* *)) | B -> () +let _ = x |> function y -> ( function _ -> y (* A *)) (* B *) +let _ = () (* This is needed here to avoid the comment above from moving *) + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k + +let default = + command##hasPermission #= (fun ctx -> foooooooooooooooooo fooooooooooo); + command##hasPermission #= (fun ctx -> + foooooooooooooooooo fooooooooooo foooooo fooooooooo foooooooooo); + foo + +let _ = ( let* ) x (fun y -> z) +let _ = ( let* ) x (function y -> z) +let _ = f (( let* ) x (fun y -> z)) +let _ = f (( let* ) x (function y -> z)) +let _ = (x >>= fun () -> ()) [@a] +let _ = ( >>= ) [@attr] +let _ = f (( >>= ) [@attr]);; + +( >>= ) [@attr] diff --git a/test/passing/refs.default/infix_bind.ml.ref b/test/passing/refs.default/infix_bind.ml.ref new file mode 100644 index 0000000000..67f685a218 --- /dev/null +++ b/test/passing/refs.default/infix_bind.ml.ref @@ -0,0 +1,222 @@ +f x >>= fun y -> +g y >>= fun () -> +f x >>= fun y -> +g y >>= fun () -> +f x >>= fun y -> +g y >>= fun () -> y () +;; + +f x >>= function +| A -> ( + g y >>= fun () -> + f x >>= fun y -> + g y >>= function + | x -> ( + f x >>= fun y -> + g y >>= function _ -> y ())) +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> fun x -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> fun xxxxxxxxx xxxxxxxxxxxxx -> x;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee +|> fun xxxxxxxx xxxxxxxxx xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> fun xxxxxxxxxxxxx -> +xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee +|> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function x -> x;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function +| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> function +| x -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function x -> x;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function +| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function xxxxxxxxx, xxxxxxxxxxxxx -> x;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee |> function +| xxxxxxxx, xxxxxxxxx, xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function +| xxxxxxxxxxxxx -> xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee |> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx + +let parens = + match body with + | { pexp_desc = Pexp_function cs; pexp_attributes; pexp_loc } -> + update_config_maybe_disabled c pexp_loc pexp_attributes @@ fun c -> + fmt "@ " + $ Cmts.fmt c.cmts pexp_loc + (wrap_if parens "(" ")" + (fmt "function" $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box $ fmt "@ " $ fmt_cases c ctx cs)) + | _ -> close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody + +let parens = + match body with + | { pexp_desc = Pexp_function cs; pexp_attributes; pexp_loc } -> ( + update_config_maybe_disabled c pexp_loc pexp_attributes @@ function + | _ -> + fmt "@ " + $ Cmts.fmt c.cmts pexp_loc + (wrap_if parens "(" ")" + (fmt "function" $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box $ fmt "@ " $ fmt_cases c ctx cs)) + | _ -> + close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody) + +let end_gen_implementation ?toplevel ~ppf_dump (clambda : clambda_and_constants) + = + Emit.begin_assembly (); + ( clambda + ++ Profile.record "cmm" (Cmmgen.compunit ~ppf_dump) + ++ Profile.record "compile_phrases" (List.iter (compile_phrase ~ppf_dump)) + ++ fun () -> () ); + fooooooooooooooo + +let foo = + (* get the tree origin *) + get_store_tree s >>= function + | None -> f t >|= fun x -> Ok x (* no transaction is needed *) + | Some (origin, old_tree) -> + let batch = { repo; tree = old_tree; origin } in + let b = Batch batch in + foo + +let _ = foo >>= function[@warning "-4"] A -> false | B -> true + +let _ = + foo >>= function[@warning "-4"] + | Afoooooooooooooooooo fooooooooo -> false + | Bfoooooooooooooooooooooo fooooooooo -> true + +let _ = foo >>= fun [@warning "-4"] x -> fooooooooooooooooooooooo + +let _ = + foo >>= fun [@warning "-4"] x y -> + fooooooooooooooooooooooo fooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooooooo + +let _ = + foo >>= function(* foo before *) [@warning "-4"] (* foo after *) + | Afoooooooooooooooooo fooooooooo -> false + | Bfoooooooooooooooooooooo fooooooooo -> true + +let _ = + foo >>= fun (* foo before *) [@warning "-4"] (* foo after *) x -> + fooooooooooooooooooooooo + +let f = Ok () >>= (* *) fun _ -> Ok () + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () >>= (* *) fun _ -> + Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +let f = Ok () >>= (* *) function Foo -> Ok () + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () >>= (* *) function + | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + fun foooooo fooooo foooo foooooo -> + Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + function + | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +(** The tests below are testing a dropped comment with + `--no-break-infix-before-func` *) + +let _ = x |> fun y -> y (* *) +let _ = x |> function y -> y (* *) +let _ = match () with A -> ( x |> function y -> y (* *)) | B -> () +let _ = x |> function y -> ( function _ -> y (* A *)) (* B *) +let _ = () (* This is needed here to avoid the comment above from moving *) + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k + +let default = + command##hasPermission #= (fun ctx -> foooooooooooooooooo fooooooooooo); + command##hasPermission #= (fun ctx -> + foooooooooooooooooo fooooooooooo foooooo fooooooooo foooooooooo); + foo + +let _ = ( let* ) x (fun y -> z) +let _ = ( let* ) x (function y -> z) +let _ = f (( let* ) x (fun y -> z)) +let _ = f (( let* ) x (function y -> z)) +let _ = (x >>= fun () -> ()) [@a] +let _ = ( >>= ) [@attr] +let _ = f (( >>= ) [@attr]);; + +( >>= ) [@attr] diff --git a/test/passing/refs.default/infix_precedence.ml.ref b/test/passing/refs.default/infix_precedence.ml.ref new file mode 100644 index 0000000000..ae818108b8 --- /dev/null +++ b/test/passing/refs.default/infix_precedence.ml.ref @@ -0,0 +1,12 @@ +let dolore_tempor_in_duis duis_esse esse = + let duis_nisi = Occaecat.sed_duis_nisi duis_esse in + do_dolore_quis_dolore duis_nisi esse + || ((not + (match duis_nisi with + | Qui.Occaecat.Enim esse_magna -> + Qui.Occaecat.Enim.do_commodo_dolore esse_magna + | _ -> false)) + && Occaecat.sed_aliqua duis_esse <> PariAtur.Aliquip + && not + (Adipisicing.magna_tempor_ipsum_elit_nisi duis_esse + Adipisicing.loremipSumDolorsi)) diff --git a/test/passing/refs.default/injectivity.ml.ref b/test/passing/refs.default/injectivity.ml.ref new file mode 100644 index 0000000000..73c6a47593 --- /dev/null +++ b/test/passing/refs.default/injectivity.ml.ref @@ -0,0 +1,76 @@ +type !'a t = private 'a ref +type +!'a t = private 'a +type -!'a t = private 'a -> unit +type +!'a t = private 'a +type -!'a t = private 'a -> unit +type +!'a t = private 'a +type -!'a t = private 'a -> unit +type +!'a t = private 'a +type -!'a t = private 'a -> unit + +module M : sig + type +!'a t +end = struct + type 'a t = 'a list +end + +module N : sig + type +'a t +end = struct + type 'a t = 'a list +end + +type !'a t = 'a list +type !'a u = int + +module M : sig + type !'a t = private < m : int ; .. > +end = struct + type 'a t = < m : int > +end + +type 'a t = 'b constraint 'a = < b : 'b > +type !'b u = < b : 'b > t +type !_ t = X +type (_, _) eq = Refl : ('a, 'a) eq +type !'a t = private 'b constraint 'a = < b : 'b > +type !'a t = private 'b constraint 'a = < b : 'b ; c : 'c > + +module M : sig + type !'a t constraint 'a = < b : 'b ; c : 'c > +end = struct + type nonrec 'a t = 'a t +end + +type !'a u = int constraint 'a = 'b t + +module F (X : sig + type 'a t +end) = +struct + type !'a u = 'b constraint 'a = < b : 'b > constraint 'b = _ X.t +end + +module F (X : sig + type 'a t +end) = +struct + type !'a u = 'b X.t constraint 'a = < b : 'b X.t > +end + +module F (X : sig + type 'a t +end) = +struct + type !'a u = 'b constraint 'a = < b : (_ X.t as 'b) > +end + +module rec R : sig + type !'a t = [ `A of 'a S.t ] +end = + R + +and S : sig + type !'a t = 'a R.t +end = + S diff --git a/test/passing/tests/into_infix.ml.ref b/test/passing/refs.default/into_infix.ml.ref similarity index 100% rename from test/passing/tests/into_infix.ml.ref rename to test/passing/refs.default/into_infix.ml.ref diff --git a/test/passing/refs.default/invalid.ml.ref b/test/passing/refs.default/invalid.ml.ref new file mode 100644 index 0000000000..17f525f0cb --- /dev/null +++ b/test/passing/refs.default/invalid.ml.ref @@ -0,0 +1,7 @@ +let f = function "as" .. 3 | 3. .. 'q' | 3 .. -3. | -3. .. 3 -> () +let f = function (lazy (exception A)) -> () | exception (lazy A) -> () +let f = (A) a b +let f = (A x) a b +let f = (`A) a b +let f = (`A x) a b +let f = (( :: )) a b c diff --git a/test/passing/refs.default/invalid_docstring.ml.err b/test/passing/refs.default/invalid_docstring.ml.err new file mode 100644 index 0000000000..3f26f01d41 --- /dev/null +++ b/test/passing/refs.default/invalid_docstring.ml.err @@ -0,0 +1,6 @@ +Warning: Invalid documentation comment: +File "invalid_docstring.ml", line 1, characters 5-5: +End of text is not allowed in '{v ... v}' (verbatim text). +Warning: Invalid documentation comment: +File "invalid_docstring.ml", line 1, characters 3-5: +'{v ... v}' (verbatim text) should not be empty. diff --git a/test/passing/tests/invalid_docstring.ml.ref b/test/passing/refs.default/invalid_docstring.ml.ref similarity index 100% rename from test/passing/tests/invalid_docstring.ml.ref rename to test/passing/refs.default/invalid_docstring.ml.ref diff --git a/test/passing/tests/invalid_docstrings.mli.ref b/test/passing/refs.default/invalid_docstrings.mli.ref similarity index 60% rename from test/passing/tests/invalid_docstrings.mli.ref rename to test/passing/refs.default/invalid_docstrings.mli.ref index accc12530d..7eeb173fc1 100644 --- a/test/passing/tests/invalid_docstrings.mli.ref +++ b/test/passing/refs.default/invalid_docstrings.mli.ref @@ -3,5 +3,5 @@ val x : y - registered into {!resolvers} - used as a service with {!serve_with_handler]/{!serve} - [protocol] can be hidden - but must be registered with - {!register_protocol}. However, blablabla. *) + [protocol] can be hidden - but must be registered with {!register_protocol}. + However, blablabla. *) diff --git a/test/passing/refs.default/issue114.ml.ref b/test/passing/refs.default/issue114.ml.ref new file mode 100644 index 0000000000..dbbb06ff33 --- /dev/null +++ b/test/passing/refs.default/issue114.ml.ref @@ -0,0 +1 @@ +let () = (f ()).(2) <- e diff --git a/test/passing/refs.default/issue1750.ml.err b/test/passing/refs.default/issue1750.ml.err new file mode 100644 index 0000000000..5f58b9db33 --- /dev/null +++ b/test/passing/refs.default/issue1750.ml.err @@ -0,0 +1 @@ +Warning: issue1750.ml:38 exceeds the margin diff --git a/test/passing/refs.default/issue1750.ml.ref b/test/passing/refs.default/issue1750.ml.ref new file mode 100644 index 0000000000..4c5fad0f7a --- /dev/null +++ b/test/passing/refs.default/issue1750.ml.ref @@ -0,0 +1,112 @@ +let _ = + all + [ + all + [ + all + [ + all + [ + f + (all + [ + all + [ + all + [ + all + [ + all + [ + all + [ + all + [ + all + [ + all + [ + all + [ + all + [ + all + [ + all + [ + all + [ + identify; + ]; + ]; + ]; + ]; + ]; + ]; + ]; + ]; + ]; + ]; + ]; + ]; + ]; + ]); + ]; + ]; + ]; + ] + +let _ = function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | _ -> ()] + -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + () diff --git a/test/passing/refs.default/issue289.ml.err b/test/passing/refs.default/issue289.ml.err new file mode 100644 index 0000000000..90550aeb1c --- /dev/null +++ b/test/passing/refs.default/issue289.ml.err @@ -0,0 +1 @@ +Warning: issue289.ml:81 exceeds the margin diff --git a/test/passing/refs.default/issue289.ml.ref b/test/passing/refs.default/issue289.ml.ref new file mode 100644 index 0000000000..47ce184ab7 --- /dev/null +++ b/test/passing/refs.default/issue289.ml.ref @@ -0,0 +1,85 @@ +[@@@ocamlformat "wrap-fun-args=false"] + +let foo = + let open Gql in + [ + field "id" ~doc:"Toy ID." ~args:[] ~typ:(non_null guid) ~resolve:(function + | _ctx -> x.id); + field "id" ~doc:"Toy ID." ~args:[] ~typppp ~resolve:(function _ctx -> x.id); + field "id" ~doc:"Toy ID." ~args:[] ~typ:(non_null guid) ~resolve:(function + | A -> x.id + | B -> c); + field "id" ~doc:"Toy ID." ~args:[] ~resolve:(function A -> x.id | B -> c); + field + "id" + ~doc:"Toy ID." + ~args:[] + ~typppppppppppppppppppp + ~resolve:(function + | AAAAAAAAAAAAAAAAAAAa -> x.idddddddddddddddddddddddddd + | BBBBBBBBBBBBBBBB -> ccccccccccccccccccccccc); + field "id" ~doc:"Toy ID." ~args:[] ~resolve:(function + | AAAAAAAAAAAAAAAAAAAa -> x.idddddddddddddddddddddddddd + | BBBBBBBBBBBBBBBB -> ccccccccccccccccccccccc); + field + "id" + ~doc:"Toy ID." + ~args:[] + ~typ:(non_null guid) + ~resolve:(fun _ctx x -> x.id); + field + "name" + ~doc:"Toy name." + ~args:[] + ~typ:(non_null string) + ~resolve:(fun _ctx x -> x.name); + field + "description" + ~doc:"Toy description." + ~args:[] + ~typ:string + ~resolve:(fun _ctx x -> x.description |> Util.option_of_string); + field + "type" + ~doc:"Toy type. Possible values are: car, animal, train." + ~args:[] + ~typ:(non_null toy_type_enum) + ~resolve:(fun _ctx x -> x.toy_type); + field + "createdAt" + ~doc:"Date created." + ~args:[] + ~typ:(non_null Scalar.date_time) + ~resolve:(fun _ctx x -> x.created_at); + ] + +[@@@ocamlformat "wrap-fun-args=true"] + +let foo = + let open Gql in + [ + field "id" ~doc:"Toy ID." ~args:[] ~typ:(non_null guid) ~resolve:(function + | _ctx -> x.id); + field "id" ~doc:"Toy ID." ~args:[] ~typppp ~resolve:(function _ctx -> x.id); + field "id" ~doc:"Toy ID." ~args:[] ~typ:(non_null guid) ~resolve:(function + | A -> x.id + | B -> c); + field "id" ~doc:"Toy ID." ~args:[] ~resolve:(function A -> x.id | B -> c); + field "id" ~doc:"Toy ID." ~args:[] ~typppppppppppppppppppp + ~resolve:(function + | AAAAAAAAAAAAAAAAAAAa -> x.idddddddddddddddddddddddddd + | BBBBBBBBBBBBBBBB -> ccccccccccccccccccccccc); + field "id" ~doc:"Toy ID." ~args:[] ~resolve:(function + | AAAAAAAAAAAAAAAAAAAa -> x.idddddddddddddddddddddddddd + | BBBBBBBBBBBBBBBB -> ccccccccccccccccccccccc); + field "id" ~doc:"Toy ID." ~args:[] ~typ:(non_null guid) + ~resolve:(fun _ctx x -> x.id); + field "name" ~doc:"Toy name." ~args:[] ~typ:(non_null string) + ~resolve:(fun _ctx x -> x.name); + field "description" ~doc:"Toy description." ~args:[] ~typ:string + ~resolve:(fun _ctx x -> x.description |> Util.option_of_string); + field "type" ~doc:"Toy type. Possible values are: car, animal, train." + ~args:[] ~typ:(non_null toy_type_enum) ~resolve:(fun _ctx x -> x.toy_type); + field "createdAt" ~doc:"Date created." ~args:[] + ~typ:(non_null Scalar.date_time) ~resolve:(fun _ctx x -> x.created_at); + ] diff --git a/test/passing/refs.default/issue48.ml.ref b/test/passing/refs.default/issue48.ml.ref new file mode 100644 index 0000000000..6e59f8718d --- /dev/null +++ b/test/passing/refs.default/issue48.ml.ref @@ -0,0 +1,3 @@ +module X (* : sig val x : unit -> unit end *) = struct + let x () = print_endline "coucou" +end diff --git a/test/passing/refs.default/issue51.ml.ref b/test/passing/refs.default/issue51.ml.ref new file mode 100644 index 0000000000..36d93c1ddc --- /dev/null +++ b/test/passing/refs.default/issue51.ml.ref @@ -0,0 +1,2 @@ +val run : + unit -> (unit -> ('a, ([> `Msg of string ] as 'b)) result) -> ('a, 'b) result diff --git a/test/passing/refs.default/issue57.ml.ref b/test/passing/refs.default/issue57.ml.ref new file mode 100644 index 0000000000..b4eab1d0cc --- /dev/null +++ b/test/passing/refs.default/issue57.ml.ref @@ -0,0 +1,5 @@ +let f (`A x) = x + +let f x = + let (`A y) = x in + y diff --git a/test/passing/refs.default/issue60.ml.ref b/test/passing/refs.default/issue60.ml.ref new file mode 100644 index 0000000000..07a9b8e409 --- /dev/null +++ b/test/passing/refs.default/issue60.ml.ref @@ -0,0 +1 @@ +let x : unit = () diff --git a/test/passing/refs.default/issue77.ml.ref b/test/passing/refs.default/issue77.ml.ref new file mode 100644 index 0000000000..6114c94bd6 --- /dev/null +++ b/test/passing/refs.default/issue77.ml.ref @@ -0,0 +1,12 @@ +let div = + [ + div + ~a: + [ + Reactive.a_style + (React.S.map (sprintf "height: %dpx") + (State.player_height_signal app_state)) + (* ksprintf a_style "%s" (if_smth "min-height: 300px;" ""); *); + ] + content; + ] diff --git a/test/passing/refs.default/issue85.ml.ref b/test/passing/refs.default/issue85.ml.ref new file mode 100644 index 0000000000..cc389adc57 --- /dev/null +++ b/test/passing/refs.default/issue85.ml.ref @@ -0,0 +1,3 @@ +let f (module X) = X.x +let f = function `A { x : int = _ } -> () +let f (`A | `B) = () diff --git a/test/passing/refs.default/issue89.ml.ref b/test/passing/refs.default/issue89.ml.ref new file mode 100644 index 0000000000..6a9b7db0c4 --- /dev/null +++ b/test/passing/refs.default/issue89.ml.ref @@ -0,0 +1 @@ +let f x = !(x.(0)) diff --git a/test/passing/refs.default/ite-compact.ml.err b/test/passing/refs.default/ite-compact.ml.err new file mode 100644 index 0000000000..5f2ab6645d --- /dev/null +++ b/test/passing/refs.default/ite-compact.ml.err @@ -0,0 +1,3 @@ +Warning: ite-compact.ml:93 exceeds the margin +Warning: ite-compact.ml:98 exceeds the margin +Warning: ite-compact.ml:103 exceeds the margin diff --git a/test/passing/refs.default/ite-compact.ml.ref b/test/passing/refs.default/ite-compact.ml.ref new file mode 100644 index 0000000000..50d7e0f036 --- /dev/null +++ b/test/passing/refs.default/ite-compact.ml.ref @@ -0,0 +1,176 @@ +let _ = + if b then e + else ( + e1; + e2) + +let _ = + if b then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + +let _ = + if b then ( + e1; + e2) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else e +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then () + else ()) +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () + else ()) +;; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then () + else ()) + +let () = + f + (if a___________________________________________________________________ + then b_________________________________________________________________ + else c_________________________________________________________________) + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition then + let a = 1 in + let b = 2 in + a + b + else if other_condition then 12 + else 0 + +let _ = + if foo then + let a = 1 in + let b = 2 in + a + b + else if foo then 12 + else 0 + +let foo = + if is_sugared_list e2 then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) + +let foo = + if is_sugared_list e2 then Some (Semi, Non) + else + Some + ( ColonColon, + if exp == e2 then Right + else (Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo) ) + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + +let foo = + if some condition then + if some nested condition then some action else some other action + else some default action + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else some other action + else some default action + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo + +let _ = + if fooo then ( + ) + else if bar then ( * ) [@attr] + else if foobar then ( / ) + else ( - ) + +let _ = + if x then fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then foooooooooooooooooooooooooooooooooooooooooo + else foooooooooooooooooooooooooooooooooooooooooo + +let _ = + if + (* foo *) + foo + then 0 + else if + (* bar *) + bar + then 1 + else 2 + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.default/ite-compact_closing.ml.ref b/test/passing/refs.default/ite-compact_closing.ml.ref new file mode 100644 index 0000000000..80df58dbe2 --- /dev/null +++ b/test/passing/refs.default/ite-compact_closing.ml.ref @@ -0,0 +1,191 @@ +let _ = + if b then e + else ( + e1; + e2 + ) + +let _ = + if b then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + +let _ = + if b then ( + e1; + e2 + ) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + else e +;; + +f + ( if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then () + else () + ) +;; + +f + ( if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () + else () + ) +;; + +f + ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else () + ) +;; + +f + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then () + else () + ) + +let () = + f + ( if a___________________________________________________________________ + then b_________________________________________________________________ + else c_________________________________________________________________ + ) + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition then + let a = 1 in + let b = 2 in + a + b + else if other_condition then 12 + else 0 + +let _ = + if foo then + let a = 1 in + let b = 2 in + a + b + else if foo then 12 + else 0 + +let foo = + if is_sugared_list e2 then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) + +let foo = + if is_sugared_list e2 then Some (Semi, Non) + else + Some + ( ColonColon, + if exp == e2 then Right + else (Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo) + ) + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) + else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) + +let foo = + if some condition then + if some nested condition then some action else some other action + else some default action + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else some other action + else some default action + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo + +let _ = + if fooo then ( + ) + else if bar then ( * ) [@attr] + else if foobar then ( / ) + else ( - ) + +let _ = + if x then fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then foooooooooooooooooooooooooooooooooooooooooo + else foooooooooooooooooooooooooooooooooooooooooo + +let _ = + if + (* foo *) + foo + then 0 + else if + (* bar *) + bar + then 1 + else 2 + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.default/ite-fit_or_vertical.ml.err b/test/passing/refs.default/ite-fit_or_vertical.ml.err new file mode 100644 index 0000000000..928aa35f5e --- /dev/null +++ b/test/passing/refs.default/ite-fit_or_vertical.ml.err @@ -0,0 +1,3 @@ +Warning: ite-fit_or_vertical.ml:114 exceeds the margin +Warning: ite-fit_or_vertical.ml:119 exceeds the margin +Warning: ite-fit_or_vertical.ml:124 exceeds the margin diff --git a/test/passing/refs.default/ite-fit_or_vertical.ml.ref b/test/passing/refs.default/ite-fit_or_vertical.ml.ref new file mode 100644 index 0000000000..63d1e755e5 --- /dev/null +++ b/test/passing/refs.default/ite-fit_or_vertical.ml.ref @@ -0,0 +1,211 @@ +let _ = + if b then + e + else ( + e1; + e2) + +let _ = + if b then + e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + +let _ = + if b then ( + e1; + e2) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else + e +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then + () + else + ()) +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) +;; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then + () + else + ()) + +let () = + f + (if a___________________________________________________________________ + then + b_________________________________________________________________ + else + c_________________________________________________________________) + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition then + let a = 1 in + let b = 2 in + a + b + else if other_condition then + 12 + else + 0 + +let _ = + if foo then + let a = 1 in + let b = 2 in + a + b + else if foo then + 12 + else + 0 + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some (ColonColon, if exp == e2 then Right else Left) + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon, + if exp == e2 then + Right + else + (Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo) ) + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + +let foo = + if some condition then + if some nested condition then some action else some other action + else + some default action + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else + some other action + else + some default action + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo + +let _ = + if fooo then + ( + ) + else if bar then + ( * ) [@attr] + else if foobar then + ( / ) + else + ( - ) + +let _ = + if x then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then + foooooooooooooooooooooooooooooooooooooooooo + else + foooooooooooooooooooooooooooooooooooooooooo + +let _ = + if + (* foo *) + foo + then + 0 + else if + (* bar *) + bar + then + 1 + else + 2 + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.default/ite-fit_or_vertical_closing.ml.ref b/test/passing/refs.default/ite-fit_or_vertical_closing.ml.ref new file mode 100644 index 0000000000..9d1f6b65fb --- /dev/null +++ b/test/passing/refs.default/ite-fit_or_vertical_closing.ml.ref @@ -0,0 +1,221 @@ +let _ = + if b then + e + else ( + e1; + e2 + ) + +let _ = + if b then + e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + +let _ = + if b then ( + e1; + e2 + ) else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) else + e +;; + +f + ( if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then + () + else + () + ) +;; + +f + ( if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + () + ) +;; + +f + ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + () + ) +;; + +f + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then + () + else + () + ) + +let () = + f + ( if a___________________________________________________________________ + then + b_________________________________________________________________ + else + c_________________________________________________________________ + ) + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition then + let a = 1 in + let b = 2 in + a + b + else if other_condition then + 12 + else + 0 + +let _ = + if foo then + let a = 1 in + let b = 2 in + a + b + else if foo then + 12 + else + 0 + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some (ColonColon, if exp == e2 then Right else Left) + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon, + if exp == e2 then + Right + else + (Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo) + ) + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) + +let foo = + if some condition then + if some nested condition then some action else some other action + else + some default action + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else + some other action + else + some default action + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo + +let _ = + if fooo then + ( + ) + else if bar then + ( * ) [@attr] + else if foobar then + ( / ) + else + ( - ) + +let _ = + if x then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then + foooooooooooooooooooooooooooooooooooooooooo + else + foooooooooooooooooooooooooooooooooooooooooo + +let _ = + if + (* foo *) + foo + then + 0 + else if + (* bar *) + bar + then + 1 + else + 2 + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.default/ite-fit_or_vertical_no_indicate.ml.err b/test/passing/refs.default/ite-fit_or_vertical_no_indicate.ml.err new file mode 100644 index 0000000000..ff7892ec0f --- /dev/null +++ b/test/passing/refs.default/ite-fit_or_vertical_no_indicate.ml.err @@ -0,0 +1,3 @@ +Warning: ite-fit_or_vertical_no_indicate.ml:114 exceeds the margin +Warning: ite-fit_or_vertical_no_indicate.ml:119 exceeds the margin +Warning: ite-fit_or_vertical_no_indicate.ml:124 exceeds the margin diff --git a/test/passing/refs.default/ite-fit_or_vertical_no_indicate.ml.ref b/test/passing/refs.default/ite-fit_or_vertical_no_indicate.ml.ref new file mode 100644 index 0000000000..63d1e755e5 --- /dev/null +++ b/test/passing/refs.default/ite-fit_or_vertical_no_indicate.ml.ref @@ -0,0 +1,211 @@ +let _ = + if b then + e + else ( + e1; + e2) + +let _ = + if b then + e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + +let _ = + if b then ( + e1; + e2) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else + e +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then + () + else + ()) +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) +;; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then + () + else + ()) + +let () = + f + (if a___________________________________________________________________ + then + b_________________________________________________________________ + else + c_________________________________________________________________) + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition then + let a = 1 in + let b = 2 in + a + b + else if other_condition then + 12 + else + 0 + +let _ = + if foo then + let a = 1 in + let b = 2 in + a + b + else if foo then + 12 + else + 0 + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some (ColonColon, if exp == e2 then Right else Left) + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon, + if exp == e2 then + Right + else + (Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo) ) + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + +let foo = + if some condition then + if some nested condition then some action else some other action + else + some default action + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else + some other action + else + some default action + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo + +let _ = + if fooo then + ( + ) + else if bar then + ( * ) [@attr] + else if foobar then + ( / ) + else + ( - ) + +let _ = + if x then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then + foooooooooooooooooooooooooooooooooooooooooo + else + foooooooooooooooooooooooooooooooooooooooooo + +let _ = + if + (* foo *) + foo + then + 0 + else if + (* bar *) + bar + then + 1 + else + 2 + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.default/ite-kr.ml.ref b/test/passing/refs.default/ite-kr.ml.ref new file mode 100644 index 0000000000..b740b1e364 --- /dev/null +++ b/test/passing/refs.default/ite-kr.ml.ref @@ -0,0 +1,252 @@ +let _ = + if b then + e + else ( + e1; + e2 + ) + +let _ = + if b then + e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + +let _ = + if b then ( + e1; + e2 + ) else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) else + e +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then + () + else + ()) +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) +;; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then + () + else + ()) + +let () = + f + (if a___________________________________________________________________ + then + b_________________________________________________________________ + else + c_________________________________________________________________) + +let () = + if [@test] true then + () + else if [@other] true then + () + +let foo = + if cond1 then + arm1 + else if cond2 then + arm2 + else + arm3 + +let _ = + if condition then + let a = 1 in + let b = 2 in + a + b + else if other_condition then + 12 + else + 0 + +let _ = + if foo then + let a = 1 in + let b = 2 in + a + b + else if foo then + 12 + else + 0 + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon, + if exp == e2 then + Right + else + Left ) + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon, + if exp == e2 then + Right + else + (Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo) ) + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) + +let foo = + if some condition then + if some nested condition then + some action + else + some other action + else + some default action + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else + some other action + else + some default action + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo + +let _ = + if fooo then + ( + ) + else if bar then + ( * ) + [@attr] + else if foobar then + ( / ) + else + ( - ) + +let _ = + if x then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then + foooooooooooooooooooooooooooooooooooooooooo + else + foooooooooooooooooooooooooooooooooooooooooo + +let _ = + if + (* foo *) + foo + then + 0 + else if + (* bar *) + bar + then + 1 + else + 2 + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 + +let _ = + if x then + 42 + (* dummy *) + else + y + +let _ = + if x then + 42 + (* dummy *) + else if y then + z + else + w diff --git a/test/passing/refs.default/ite-kr_closing.ml.ref b/test/passing/refs.default/ite-kr_closing.ml.ref new file mode 100644 index 0000000000..23283099e8 --- /dev/null +++ b/test/passing/refs.default/ite-kr_closing.ml.ref @@ -0,0 +1,259 @@ +let _ = + if b then + e + else ( + e1; + e2 + ) + +let _ = + if b then + e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + +let _ = + if b then ( + e1; + e2 + ) else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) else + e +;; + +f + ( if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then + () + else + () + ) +;; + +f + ( if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + () + ) +;; + +f + ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + () + ) +;; + +f + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then + () + else + () + ) + +let () = + f + ( if a___________________________________________________________________ + then + b_________________________________________________________________ + else + c_________________________________________________________________ + ) + +let () = + if [@test] true then + () + else if [@other] true then + () + +let foo = + if cond1 then + arm1 + else if cond2 then + arm2 + else + arm3 + +let _ = + if condition then + let a = 1 in + let b = 2 in + a + b + else if other_condition then + 12 + else + 0 + +let _ = + if foo then + let a = 1 in + let b = 2 in + a + b + else if foo then + 12 + else + 0 + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon, + if exp == e2 then + Right + else + Left + ) + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon, + if exp == e2 then + Right + else + (Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo) + ) + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) + +let foo = + if some condition then + if some nested condition then + some action + else + some other action + else + some default action + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else + some other action + else + some default action + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo + +let _ = + if fooo then + ( + ) + else if bar then + ( * ) + [@attr] + else if foobar then + ( / ) + else + ( - ) + +let _ = + if x then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then + foooooooooooooooooooooooooooooooooooooooooo + else + foooooooooooooooooooooooooooooooooooooooooo + +let _ = + if + (* foo *) + foo + then + 0 + else if + (* bar *) + bar + then + 1 + else + 2 + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 + +let _ = + if x then + 42 + (* dummy *) + else + y + +let _ = + if x then + 42 + (* dummy *) + else if y then + z + else + w diff --git a/test/passing/refs.default/ite-kw_first.ml.err b/test/passing/refs.default/ite-kw_first.ml.err new file mode 100644 index 0000000000..993e8f8a6e --- /dev/null +++ b/test/passing/refs.default/ite-kw_first.ml.err @@ -0,0 +1,3 @@ +Warning: ite-kw_first.ml:108 exceeds the margin +Warning: ite-kw_first.ml:114 exceeds the margin +Warning: ite-kw_first.ml:119 exceeds the margin diff --git a/test/passing/refs.default/ite-kw_first.ml.ref b/test/passing/refs.default/ite-kw_first.ml.ref new file mode 100644 index 0000000000..0d506e7d86 --- /dev/null +++ b/test/passing/refs.default/ite-kw_first.ml.ref @@ -0,0 +1,205 @@ +let _ = + if b + then e + else ( + e1; + e2) + +let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + +let _ = + if b + then ( + e1; + e2) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + +let _ = + if b + then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else if b1 + then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else e +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong + then () + else ()) +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then () + else ()) +;; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then () + else ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then () + else ()) + +let () = + f + (if a___________________________________________________________________ + then b_________________________________________________________________ + else c_________________________________________________________________) + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition + then + let a = 1 in + let b = 2 in + a + b + else if other_condition + then 12 + else 0 + +let _ = + if foo + then + let a = 1 in + let b = 2 in + a + b + else if foo + then 12 + else 0 + +let foo = + if is_sugared_list e2 + then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) + +let foo = + if is_sugared_list e2 + then Some (Semi, Non) + else + Some + ( ColonColon, + if exp == e2 + then Right + else (Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo) ) + +let foo = + if cond1 + then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else if cond2 + then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + +let foo = + if some condition + then if some nested condition then some action else some other action + else some default action + +let foo = + if some condition + then + if some nested condition + then some action + foooo + foooo + foooooooo + foooo + foooooo + else some other action + else some default action + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 + then (* foo *) + a + b + else (* foo *) + a - b + +let foo = + if cmp < 0 + then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 + then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) + then foo + +let _ = + if fooo + then ( + ) + else if bar + then ( * ) [@attr] + else if foobar + then ( / ) + else ( - ) + +let _ = + if x + then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then foooooooooooooooooooooooooooooooooooooooooo + else foooooooooooooooooooooooooooooooooooooooooo + +let _ = + if + (* foo *) + foo + then 0 + else if + (* bar *) + bar + then 1 + else 2 + +let compare s1 s2 = + if String.equal s1 s2 + then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options + then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options + then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.default/ite-kw_first_closing.ml.ref b/test/passing/refs.default/ite-kw_first_closing.ml.ref new file mode 100644 index 0000000000..46b0eeb67f --- /dev/null +++ b/test/passing/refs.default/ite-kw_first_closing.ml.ref @@ -0,0 +1,220 @@ +let _ = + if b + then e + else ( + e1; + e2 + ) + +let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + +let _ = + if b + then ( + e1; + e2 + ) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + +let _ = + if b + then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + else if b1 + then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + else e +;; + +f + ( if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong + then () + else () + ) +;; + +f + ( if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then () + else () + ) +;; + +f + ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then () + else () + ) +;; + +f + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then () + else () + ) + +let () = + f + ( if a___________________________________________________________________ + then b_________________________________________________________________ + else c_________________________________________________________________ + ) + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition + then + let a = 1 in + let b = 2 in + a + b + else if other_condition + then 12 + else 0 + +let _ = + if foo + then + let a = 1 in + let b = 2 in + a + b + else if foo + then 12 + else 0 + +let foo = + if is_sugared_list e2 + then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) + +let foo = + if is_sugared_list e2 + then Some (Semi, Non) + else + Some + ( ColonColon, + if exp == e2 + then Right + else (Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo) + ) + +let foo = + if cond1 + then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) + else if cond2 + then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) + +let foo = + if some condition + then if some nested condition then some action else some other action + else some default action + +let foo = + if some condition + then + if some nested condition + then some action + foooo + foooo + foooooooo + foooo + foooooo + else some other action + else some default action + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 + then (* foo *) + a + b + else (* foo *) + a - b + +let foo = + if cmp < 0 + then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 + then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) + then foo + +let _ = + if fooo + then ( + ) + else if bar + then ( * ) [@attr] + else if foobar + then ( / ) + else ( - ) + +let _ = + if x + then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then foooooooooooooooooooooooooooooooooooooooooo + else foooooooooooooooooooooooooooooooooooooooooo + +let _ = + if + (* foo *) + foo + then 0 + else if + (* bar *) + bar + then 1 + else 2 + +let compare s1 s2 = + if String.equal s1 s2 + then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options + then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options + then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.default/ite-kw_first_no_indicate.ml.err b/test/passing/refs.default/ite-kw_first_no_indicate.ml.err new file mode 100644 index 0000000000..d0f03f5152 --- /dev/null +++ b/test/passing/refs.default/ite-kw_first_no_indicate.ml.err @@ -0,0 +1,3 @@ +Warning: ite-kw_first_no_indicate.ml:108 exceeds the margin +Warning: ite-kw_first_no_indicate.ml:114 exceeds the margin +Warning: ite-kw_first_no_indicate.ml:119 exceeds the margin diff --git a/test/passing/refs.default/ite-kw_first_no_indicate.ml.ref b/test/passing/refs.default/ite-kw_first_no_indicate.ml.ref new file mode 100644 index 0000000000..0d506e7d86 --- /dev/null +++ b/test/passing/refs.default/ite-kw_first_no_indicate.ml.ref @@ -0,0 +1,205 @@ +let _ = + if b + then e + else ( + e1; + e2) + +let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + +let _ = + if b + then ( + e1; + e2) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + +let _ = + if b + then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else if b1 + then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else e +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong + then () + else ()) +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then () + else ()) +;; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then () + else ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then () + else ()) + +let () = + f + (if a___________________________________________________________________ + then b_________________________________________________________________ + else c_________________________________________________________________) + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition + then + let a = 1 in + let b = 2 in + a + b + else if other_condition + then 12 + else 0 + +let _ = + if foo + then + let a = 1 in + let b = 2 in + a + b + else if foo + then 12 + else 0 + +let foo = + if is_sugared_list e2 + then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) + +let foo = + if is_sugared_list e2 + then Some (Semi, Non) + else + Some + ( ColonColon, + if exp == e2 + then Right + else (Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo) ) + +let foo = + if cond1 + then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else if cond2 + then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + +let foo = + if some condition + then if some nested condition then some action else some other action + else some default action + +let foo = + if some condition + then + if some nested condition + then some action + foooo + foooo + foooooooo + foooo + foooooo + else some other action + else some default action + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 + then (* foo *) + a + b + else (* foo *) + a - b + +let foo = + if cmp < 0 + then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 + then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) + then foo + +let _ = + if fooo + then ( + ) + else if bar + then ( * ) [@attr] + else if foobar + then ( / ) + else ( - ) + +let _ = + if x + then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then foooooooooooooooooooooooooooooooooooooooooo + else foooooooooooooooooooooooooooooooooooooooooo + +let _ = + if + (* foo *) + foo + then 0 + else if + (* bar *) + bar + then 1 + else 2 + +let compare s1 s2 = + if String.equal s1 s2 + then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options + then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options + then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.default/ite-no_indicate.ml.err b/test/passing/refs.default/ite-no_indicate.ml.err new file mode 100644 index 0000000000..74ca3adeea --- /dev/null +++ b/test/passing/refs.default/ite-no_indicate.ml.err @@ -0,0 +1,3 @@ +Warning: ite-no_indicate.ml:93 exceeds the margin +Warning: ite-no_indicate.ml:98 exceeds the margin +Warning: ite-no_indicate.ml:103 exceeds the margin diff --git a/test/passing/refs.default/ite-no_indicate.ml.ref b/test/passing/refs.default/ite-no_indicate.ml.ref new file mode 100644 index 0000000000..50d7e0f036 --- /dev/null +++ b/test/passing/refs.default/ite-no_indicate.ml.ref @@ -0,0 +1,176 @@ +let _ = + if b then e + else ( + e1; + e2) + +let _ = + if b then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + +let _ = + if b then ( + e1; + e2) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else e +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then () + else ()) +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () + else ()) +;; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then () + else ()) + +let () = + f + (if a___________________________________________________________________ + then b_________________________________________________________________ + else c_________________________________________________________________) + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition then + let a = 1 in + let b = 2 in + a + b + else if other_condition then 12 + else 0 + +let _ = + if foo then + let a = 1 in + let b = 2 in + a + b + else if foo then 12 + else 0 + +let foo = + if is_sugared_list e2 then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) + +let foo = + if is_sugared_list e2 then Some (Semi, Non) + else + Some + ( ColonColon, + if exp == e2 then Right + else (Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo) ) + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + +let foo = + if some condition then + if some nested condition then some action else some other action + else some default action + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else some other action + else some default action + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo + +let _ = + if fooo then ( + ) + else if bar then ( * ) [@attr] + else if foobar then ( / ) + else ( - ) + +let _ = + if x then fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then foooooooooooooooooooooooooooooooooooooooooo + else foooooooooooooooooooooooooooooooooooooooooo + +let _ = + if + (* foo *) + foo + then 0 + else if + (* bar *) + bar + then 1 + else 2 + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.default/ite-vertical.ml.err b/test/passing/refs.default/ite-vertical.ml.err new file mode 100644 index 0000000000..6af8c8dff8 --- /dev/null +++ b/test/passing/refs.default/ite-vertical.ml.err @@ -0,0 +1,3 @@ +Warning: ite-vertical.ml:130 exceeds the margin +Warning: ite-vertical.ml:135 exceeds the margin +Warning: ite-vertical.ml:140 exceeds the margin diff --git a/test/passing/refs.default/ite-vertical.ml.ref b/test/passing/refs.default/ite-vertical.ml.ref new file mode 100644 index 0000000000..7c3e107e9e --- /dev/null +++ b/test/passing/refs.default/ite-vertical.ml.ref @@ -0,0 +1,250 @@ +let _ = + if b then + e + else ( + e1; + e2) + +let _ = + if b then + e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + +let _ = + if b then ( + e1; + e2) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else + e +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then + () + else + ()) +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) +;; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then + () + else + ()) + +let () = + f + (if a___________________________________________________________________ + then + b_________________________________________________________________ + else + c_________________________________________________________________) + +let () = + if [@test] true then + () + else if [@other] true then + () + +let foo = + if cond1 then + arm1 + else if cond2 then + arm2 + else + arm3 + +let _ = + if condition then + let a = 1 in + let b = 2 in + a + b + else if other_condition then + 12 + else + 0 + +let _ = + if foo then + let a = 1 in + let b = 2 in + a + b + else if foo then + 12 + else + 0 + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon, + if exp == e2 then + Right + else + Left ) + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon, + if exp == e2 then + Right + else + (Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo) ) + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + +let foo = + if some condition then + if some nested condition then + some action + else + some other action + else + some default action + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else + some other action + else + some default action + +let foo = + if cmp < 0 then + (* foo *) + a + b + else + (* foo *) + a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo + +let _ = + if fooo then + ( + ) + else if bar then + ( * ) + [@attr] + else if foobar then + ( / ) + else + ( - ) + +let _ = + if x then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then + foooooooooooooooooooooooooooooooooooooooooo + else + foooooooooooooooooooooooooooooooooooooooooo + +let _ = + if + (* foo *) + foo + then + 0 + else if + (* bar *) + bar + then + 1 + else + 2 + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 + +let _ = + if x then + 42 + (* dummy *) + else + y + +let _ = + if x then + 42 + (* dummy *) + else if y then + z + else + w diff --git a/test/passing/refs.default/ite.ml.err b/test/passing/refs.default/ite.ml.err new file mode 100644 index 0000000000..9e81cd5e2d --- /dev/null +++ b/test/passing/refs.default/ite.ml.err @@ -0,0 +1,3 @@ +Warning: ite.ml:93 exceeds the margin +Warning: ite.ml:98 exceeds the margin +Warning: ite.ml:103 exceeds the margin diff --git a/test/passing/refs.default/ite.ml.ref b/test/passing/refs.default/ite.ml.ref new file mode 100644 index 0000000000..50d7e0f036 --- /dev/null +++ b/test/passing/refs.default/ite.ml.ref @@ -0,0 +1,176 @@ +let _ = + if b then e + else ( + e1; + e2) + +let _ = + if b then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + +let _ = + if b then ( + e1; + e2) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else e +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then () + else ()) +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () + else ()) +;; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then () + else ()) + +let () = + f + (if a___________________________________________________________________ + then b_________________________________________________________________ + else c_________________________________________________________________) + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition then + let a = 1 in + let b = 2 in + a + b + else if other_condition then 12 + else 0 + +let _ = + if foo then + let a = 1 in + let b = 2 in + a + b + else if foo then 12 + else 0 + +let foo = + if is_sugared_list e2 then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) + +let foo = + if is_sugared_list e2 then Some (Semi, Non) + else + Some + ( ColonColon, + if exp == e2 then Right + else (Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo) ) + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + +let foo = + if some condition then + if some nested condition then some action else some other action + else some default action + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else some other action + else some default action + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo + +let _ = + if fooo then ( + ) + else if bar then ( * ) [@attr] + else if foobar then ( / ) + else ( - ) + +let _ = + if x then fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then foooooooooooooooooooooooooooooooooooooooooo + else foooooooooooooooooooooooooooooooooooooooooo + +let _ = + if + (* foo *) + foo + then 0 + else if + (* bar *) + bar + then 1 + else 2 + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.default/js_args.ml.ref b/test/passing/refs.default/js_args.ml.ref new file mode 100644 index 0000000000..8a4d20efe5 --- /dev/null +++ b/test/passing/refs.default/js_args.ml.ref @@ -0,0 +1,127 @@ +let () = foo.bar <- f x y z + +let should_check_can_sell_and_marking regulatory_regime = + match z with `foo -> some_function argument + +(* The above typically occurs in a multi-pattern match clause, so the clause + expression is on a line by itself. This is the more typical way a long + single-pattern match clause would be written: *) +let should_check_can_sell_and_marking regulatory_regime = + match z with `foo -> some_function argument + +let f = fun x -> ghi x + +(* common *) +let x = try x with a -> b | c -> d +let x = try x with a -> b | c -> d +let x = try x with a -> b | c -> d +let z = some_function argument +let () = f a b ~c d +let () = f a b ~c:1. d +let () = My_module.f a b ~c d + +(* This last case is where Tuareg is inconsistent with the others. *) +let () = My_module.f a b ~c:1. d + +let () = + messages := + Message_store.create (Session_id.of_string "") + (* Tuareg indents these lines too far to the left. *) + "herd-retransmitter" + Message_store.Message_size.Byte + +let () = + raise + (Bug + ("foo" + (* In this and similar cases, we want the subsequent lines to + align with the first expression. *) + ^ "bar")); + raise (Bug ("foo" ^ "quux" ^ "bar")); + raise (Bug ((foo + quux) ^ "bar")); + raise (Bug ((foo + quux) ^ "bar")) + +(* Except in specific cases, we want the argument indented relative to the + function being called. (Exceptions include "fun" arguments where the line + ends with "->" and subsequent lines beginning with operators, like above.) *) +let () = + Some + (Message_store.create s "herd-retransmitter" ~unlink:true + Message_store.Message_size.Byte) + +(* We like the indentation of most arguments, but want to get back towards the + left margin in a few special cases: *) +let _ = + foo + (bar (fun x -> + (* special: "fun _ ->" at EOL *) + baz)) +(* assume no more arguments to "bar" *) + +let _ = foo ~a_long_field_name:(check (fun bar -> baz)) +let _ = foo ~a_long_field_name:(check (fun bar -> baz)) + +let _ = + foo + (bar + (quux + (fnord (fun x -> + (* any depth *) + baz)))) + +(* We also wanted to tweak the operator indentation, making operators like <= + not special cases in contexts like this: *) +let _ = assert (foo (bar + baz <= quux)) +(* lined up under left argument to op, + sim. to ^ above *) + +(* Sim. indentation of if conditions: *) +let _ = if a <= b then () + +let _ = + (* Comparisons are different than conditionals; we don't regard them as + conceptually part of the [if] expression. *) + if a <= b then () + +let _ = + (* We regard the outermost condition terms as conceptually part of the [if] + expression and indent accordingly. Whether [&&] or [||], conditionals + effectively state lists of conditions for [then]. *) + if + Edge_adjustment.is_zero arb.cfg.extra_edge + && 0. = sys.plugs.edge_backoff + && 0. = zero_acvol_edge_backoff + then 0. + else 1. + +let _ = + if + Edge_adjustment.is_zero arb.cfg.extra_edge + && 0. = sys.plugs.edge_backoff + && 0. = zero_acvol_edge_backoff + then 0. + else 1. + +let _ = + let entries = + List.filter (Lazy.force transferstati) ~f:(fun ts -> + Pcre.pmatch ~pat ts.RQ.description) + in + x + +(* combination of operator at BOL and -> at EOL: *) +let _ = + Shell.ssh_lines x + |! List.map + ~f: + (f + (g (fun x -> + let name, path = String.lsplit2_exn ~on:'|' x in + (String.strip name, String.strip path)))) + +(* open paren ending line like begin *) +let _ = + if a (p ^/ "s") [ e ] = Ok () then + `S + (let label count = sprintf "%d s" c ^ if c = 1 then ":" else "s" in + x) diff --git a/test/passing/refs.default/js_begin.ml.ref b/test/passing/refs.default/js_begin.ml.ref new file mode 100644 index 0000000000..43cb1a7e09 --- /dev/null +++ b/test/passing/refs.default/js_begin.ml.ref @@ -0,0 +1,11 @@ +let f = function + | zoo -> + foo; + bar + +let g = function + | zoo -> + foo; + bar + +let () = match foo with Bar -> snoo diff --git a/test/passing/refs.default/js_bind.ml.ref b/test/passing/refs.default/js_bind.ml.ref new file mode 100644 index 0000000000..708353afa7 --- /dev/null +++ b/test/passing/refs.default/js_bind.ml.ref @@ -0,0 +1,21 @@ +let assigned_to u = + Deferred.List.filter (Request_util.requests ()) ~f:(fun request -> + if _ then _ + else + status_request ~request () ~msg_client:no_msg >>= fun status -> + not (up_to_date_user status u)) + +let old_good = + foo bar qaz *>>= fun x -> + hey ho lala *>>= fun y -> return (x, y) + +let old_good = + foo bar qaz +>>= fun x -> + hey ho lala +>>= fun y -> return (x, y) + +(* generalizations based on Tuareg code *) +let old_good = + foo bar qaz *>>| fun x -> + hey ho lala *>>> fun y -> + foo bar qaz +>>| fun x -> + hey ho lala +>>> fun y -> return (x, y) diff --git a/test/passing/refs.default/js_fun.ml.ref b/test/passing/refs.default/js_fun.ml.ref new file mode 100644 index 0000000000..b9f35f9e53 --- /dev/null +++ b/test/passing/refs.default/js_fun.ml.ref @@ -0,0 +1,32 @@ +(* preferred list style *) +let z = f [ y; foo ~f:(fun () -> arg) ] +let z = f [ y; foo ~f:(fun () -> arg) ] + +(* legacy list style *) +let _ = [ f (fun x -> x); f (fun x -> x); f (fun x -> x) ] +let _ = [ f (fun x -> x); f (fun x -> x); f (fun x -> x) ] +let _ = [ f (fun x -> x); f (fun x -> x); f (fun x -> x) ] + +let _ = + x >>= fun x -> + (try x with _ -> ()) >>= fun x -> try x with _ -> () >>= fun x -> x + +let () = expr >>| function x -> 3 | y -> 4 +let () = expr >>| fun z -> match z with x -> 3 | y -> 4 +let () = expr >>| fun z -> function x -> 3 | y -> 4 +let () = my_func () >>= function A -> 0 | B -> 0 +let () = my_func () >>= function A -> 0 | B -> 0 +let () = expr >>| function x -> 3 | y -> 4 +let () = expr >>| function x -> 3 | y -> 4 + +let f = + f >>= m (fun f -> fun x -> y); + z + +let f = + f |> m (fun f -> fun x -> y); + z + +let f = + f |> m (fun f -> fun x -> y); + z diff --git a/test/passing/tests/js_map.ml.ref b/test/passing/refs.default/js_map.ml.ref similarity index 100% rename from test/passing/tests/js_map.ml.ref rename to test/passing/refs.default/js_map.ml.ref diff --git a/test/passing/refs.default/js_pattern.ml.ref b/test/passing/refs.default/js_pattern.ml.ref new file mode 100644 index 0000000000..c59b7c9b06 --- /dev/null +++ b/test/passing/refs.default/js_pattern.ml.ref @@ -0,0 +1,16 @@ +let f = function _ -> 0 +let f x = match x with _ -> 0 +let f = function _ -> 0 +let f x = match x with _ -> 0 +let f x = match x with _ -> 0 + +let check_price t = function + | { Exec.trade_at_settlement = None | Some false } -> () + +let check_price t = function simpler -> () | other -> () + +(* Sometimes we like to write big alternations like this, in which case the + comment should typically align with the following clause. *) +let 0 = match x with A (* a *) -> a +let 0 = match x with A (* a *) -> a +let _ = a || match a with a -> true | b -> false diff --git a/test/passing/refs.default/js_poly.ml.ref b/test/passing/refs.default/js_poly.ml.ref new file mode 100644 index 0000000000..0e1122bae0 --- /dev/null +++ b/test/passing/refs.default/js_poly.ml.ref @@ -0,0 +1,6 @@ +let handle_query qs ~msg_client:_ = + try_with (fun () -> if _ then f >>| fun () -> `Done () else _) +;; + +if _ then _ +else assert_branch_has_node branch node >>| fun () -> { t with node; floating } diff --git a/test/passing/refs.default/js_record.ml.ref b/test/passing/refs.default/js_record.ml.ref new file mode 100644 index 0000000000..af496a207f --- /dev/null +++ b/test/passing/refs.default/js_record.ml.ref @@ -0,0 +1,50 @@ +type x = { foo : int; bar : int } + +let x = { x with foo = 3; bar = 5 } + +let x = + { + (* blah blah blah *) + foo = 3; + bar = 5; + } + +let x = [ { x with foo = 3; bar = 5 } ] + +let x = + [ + { + (* blah blah blah *) + foo = 3; + bar = 5; + }; + ] + +let x = { M.x with M.foo = 3 } +let x = { x with M.foo = 3 } +let x = { M.foo = 3 } +let _ = { foo with Bar.field1 = value1; field2 = value2 } +let _ = { foo with Bar.field1 = value1; field2 = value2 } + +(* multicomponent record module pathname *) +let _ = { A.B.a = b; c = d } + +type t = { a : something_lengthy list list [@default String.Map.empty] } +type t = { a : Something_lengthy.t list list [@default String.Map.empty] } +type t = { a : something_lengthy list list } +type t = { a : Something_lengthy.t list list } +type t = { a : Something_lengthy.t list } + +type t = { + for_intf : Dune_rules.Module_name.t list; + (* direct module dependencies for the interface *) + for_impl : Dune_rules.Module_name.t list; + (* direct module dependencies for the implementation *) +} + +type t = { + for_intf : Dune_rules.Module_name.t list; + (* direct module dependencies for the interface *) + (* direct module dependencies for the interface *) + for_impl : Dune_rules.Module_name.t list; +} diff --git a/test/passing/refs.default/js_sig.mli.ref b/test/passing/refs.default/js_sig.mli.ref new file mode 100644 index 0000000000..de738bd9c4 --- /dev/null +++ b/test/passing/refs.default/js_sig.mli.ref @@ -0,0 +1,22 @@ +open! Core + +exception First_exception +(** First documentation comment. *) + +exception Second_exception +(** Second documentation comment. *) + +[@@@ocamlformat "parse-docstrings=true"] +[@@@ocamlformat "wrap-comments=true"] + +(** {e foooooooo oooooo oooo oooo ooooo oooo ooooo} + {i fooooo ooooo ooo oooooo oo oooooo oooo} + {b fooooooo oooooo oooooo oooooo oooooo ooooooo} *) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo} + {{!some ref} fooooooooooooo oooooooo oooooooooo} + {b fooooooooooooo oooooooooooo oooooo ooooooo} *) + +class c : 'a -> object + val x : 'b +end diff --git a/test/passing/refs.default/js_source.ml.err b/test/passing/refs.default/js_source.ml.err new file mode 100644 index 0000000000..51f317bf58 --- /dev/null +++ b/test/passing/refs.default/js_source.ml.err @@ -0,0 +1,5 @@ +Warning: js_source.ml:122 exceeds the margin +Warning: js_source.ml:156 exceeds the margin +Warning: js_source.ml:229 exceeds the margin +Warning: js_source.ml:327 exceeds the margin +Warning: js_source.ml:809 exceeds the margin diff --git a/test/passing/refs.default/js_source.ml.ref b/test/passing/refs.default/js_source.ml.ref new file mode 100644 index 0000000000..c84eee7556 --- /dev/null +++ b/test/passing/refs.default/js_source.ml.ref @@ -0,0 +1,828 @@ +(* Signature items *) +module type S = sig + class%foo x : t [@@foo] + + class type%foo x = x [@@foo] +end + +include struct + let%test_module "as" = + (module struct + let%expect_test + "xx xx xxxxxx xxxxxxx xxxxxx xxxxxx xxxxxxxx xx xxxxx xxx xx xxxxx" = + () + end) +end +;; + +if fffffffffffffff aaaaa bb then (if b then aaaaaaaaaaaaaaaa ffff) +else aaaaaaaaaaaa qqqqqqqqqqq + +include Base.Fn +(** @open *) + +let ssmap : + (module MapT + with type key = string + and type data = string + and type map = SSMap.map) = + () + +let ssmap : + (module MapT + with type key = string + and type data = string + and type map = SSMap.map) -> + unit = + () + +let _ = match x with A -> [%expr match y with e -> e] +let _ = match x with A -> [%expr match y with e -> ( match e with x -> x)] + +let _ = + List.map rows ~f:(fun row -> + Or_error.try_with (fun () -> fffffffffffffffffffffffff row)) + +module type T = sig + val find : t -> key -> value option + (** @raise if not found. *) + + val f : + a_few:params -> + with_long_names:to_break -> + the_line:before_the_comment -> + unit + (** @param blablabla *) +end + +open! Core + +exception First_exception +(** First documentation comment. *) + +exception Second_exception +(** Second documentation comment. *) + +module M = struct + type t + [@@immediate] + (* ______________________________________ *) + [@@deriving variants, sexp_of] +end + +module type Basic3 = sig + type ('a, 'd, 'e) t + + val return : 'a -> ('a, _, _) t + val apply : ('a -> 'b, 'd, 'e) t -> ('a, 'd, 'e) t -> ('b, 'd, 'e) t + + val map : + [ `Define_using_apply + | `Custom of ('a, 'd, 'e) t -> f:('a -> 'b) -> ('b, 'd, 'e) t ] +end + +let _ = + aa + (bbbbbbbbb cccccccccccc + dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd) + +let _ = + "_______________________________________________________ \ + _______________________________" + +let _ = + [ + very_long_function_name____________________ + very_long_argument_name____________; + ] + +(* FIX: exceed 90 columns *) +let _ = + [%str + let () = + very_long_function_name__________________ + very_long_argument_name____________] + +let _ = + { + long_field_name = + 9999999999999999999999999999999999999999999999999999999999999999999; + } + +(* FIX: exceed 90 columns *) +let _ = + match () with + | _ -> ( + match () with + | _ -> + long_function_name + long_argument_name__________________________________________) + +let _ = + aaaaaaa + (* __________________________________________________________________________________ *) + := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + +let g = f ~x (* this is a multiple-line-spanning + comment *) ~y + +let f = + very_long_function_name + ~x:very_long_variable_name + (* this is a multiple-line-spanning + comment *) + ~y + +let _ = + match x with + | { + y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ); + } -> + () + +let _ = + match x with + | { + y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ); + } -> + () + +type t = + [ `XXXX + (* __________________________________________________________________________________ *) + | `XXXX + (* __________________________________________________________________ *) + | `XXXX (* _____________________________________________________ *) + | `XXXX (* ___________________________________________________ *) + | `XXXX (* ___________________________________________________ *) + | `XXXX (* ________________________________________________ *) + | `XXXX (* __________________________________________ *) + | `XXXX (* _________________________________________ *) + | `XXXX (* ______________________________________ *) + | `XXXX (* ____________________________________ *) ] + +type t = { + field : ty; + (* Here is some verbatim formatted text: + {v + starting at column 7 + v}*) +} + +module Intro_sort = struct + let foo_fooo_foooo fooo ~foooo m1 m2 m3 m4 m5 = + (* Fooooooooooooooooooooooooooo: + {v + 1--o-----o-----o--------------1 + | | | + 2--o-----|--o--|-----o--o-----2 + | | | | | + 3--------o--o--|--o--|--o-----3 + | | | + 4-----o--------o--o--|-----o--4 + | | | + 5-----o--------------o-----o--5 + v} *) + foooooooooo fooooo fooo; + foooooooooo fooooo fooo; + foooooooooo fooooo fooo +end + +let _ = + "_ _____________________ ___________ ________ _____________ ________ \ + _____________ _____\n\n\ + \ ___________________" + +let nullsafe_optimistic_third_party_params_in_non_strict = + CLOpt.mk_bool + ~long:"nullsafe-optimistic-third-party-params-in-non-strict" + (* Turned on for compatibility reasons. Historically this is because + there was no actionable way to change third party annotations. Now + that we have such a support, this behavior should be reconsidered, + provided our tooling and error reporting is friendly enough to be + smoothly used by developers. *) + ~default:true + "Nullsafe: in this mode we treat non annotated third party method params \ + as if they were annotated as nullable." + +let foo () = + if%bind + (* this is a medium length comment of some sort *) + this is a medium length expression of_some sort + then x + else y + +let _ = + match x with + | _ + when f + ~f:(function [@ocaml.warning + (* ....................................... *) "-4"] + | _ -> .) -> + y + +let[@a + (* .............................................. ........................... .......................... ...................... *) + foo + (* ....................... *) + (* ................................. *) + (* ...................... *)] _ = + match[@ocaml.warning (* ....................................... *) "-4"] + x [@attr (* .......................... .................. *) some_attr] + with + | _ + when f + ~f:(function[@ocaml.warning + (* ....................................... *) "-4"] + | _ -> .) + ~f:(function[@ocaml.warning + (* ....................................... *) + (* ....................................... *) + "foooooooooooooooooooooooooooo \ + fooooooooooooooooooooooooooooooooooooo"] _ -> .) + ~f:(function[@ocaml.warning + (* ....................................... *) + let x = a and y = b in + x + y] _ -> .) -> + y + [@attr + (* ... *) + (* ... *) + attr (* ... *)] + +let x = + foo (`A b) ~f:(fun thing -> + something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs + wrapping) + +let x = + foo (`A `b) ~f:(fun thing -> + something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs + wrapping) + +let x = + foo [ A; B ] ~f:(fun thing -> + something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs + wrapping) + +let x = + foo [ [ A ]; B ] ~f:(fun thing -> + something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs + wrapping) + +let x = + f + ("A string _____________________" ^ "Another string _____________" + ^ "Yet another string _________") + +let x = + some_fun________________________________ + some_arg______________________________ (fun param -> + do_something (); + do_something_else (); + return_this_value) + +let x = + some_fun________________________________ + some_arg______________________________ ~f:(fun param -> + do_something (); + do_something_else (); + return_this_value) + +let x = + some_value + |> some_fun (fun x -> + do_something (); + do_something_else (); + return_this_value) + +let x = + some_value + ^ some_fun (fun x -> + do_something (); + do_something_else (); + return_this_value) + +let bind t ~f = + unfold_step + ~f:(function + | Sequence { state = seed; next }, rest -> ( + match next seed with + | Done -> ( + match rest with + | Sequence { state = seed; next } -> ( + match next seed with + | Done -> Done + | Skip { state = s } -> + Skip { state = (empty, Sequence { state = s; next }) } + | Yield { value = a; state = s } -> + Skip { state = (f a, Sequence { state = s; next }) })) + | Skip { state = s } -> + Skip { state = (Sequence { state = s; next }, rest) } + | Yield { value = a; state = s } -> + Yield { value = a; state = (Sequence { state = s; next }, rest) })) + ~init:(empty, t) + +let () = + very_long_function_name + ~very_long_argument_label:(fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> ()) + +let () = + ((one_mississippi, two_mississippi, three_mississippi, four_mississippi) + : Mississippi.t * Mississippi.t * Mississippi.t * Mississippi.t) + +let _ = (match foo with Bar -> bar | Baz -> baz : string) +let _ = (match foo with Bar -> bar | Baz -> baz :> string) + +let _ = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + ~bbbbbbbbbbbbbbbbbbbbbbbbbbbb:(fun + (_ : (ccccccccccccc * ddddddddddddddddddddddddddddd) eeee) -> + FFFFFFFFF gg) + ~h + +type t +[@@deriving + some_deriver_name, + another_deriver_name, + another_deriver_name, + another_deriver_name, + yet_another_such_name, + such_that_they_line_wrap] + +type t +[@@deriving + some_deriver_name another_deriver_name another_deriver_name + another_deriver_name yet_another_such_name such_that_they_line_wrap] + +let pat = + String.Search_pattern.create + (String.init len ~f:(function + | 0 -> '\n' + | n when n < len - 1 -> ' ' + | _ -> '*')) + +type t = { + break_separators : [ `Before | `After ]; + break_sequences : bool; + break_string_literals : [ `Auto | `Never ]; + (** How to potentially break string literals into new lines. *) + break_struct : bool; + cases_exp_indent : int; + cases_matching_exp_indent : [ `Normal | `Compact ]; +} + +let rec collect_files ~enable_outside_detected_project ~root ~segs ~ignores + ~enables ~files = + match segs with [] | [ "" ] -> (ignores, enables, files, None) + +let _ = + fooooooooooooooooooooooooooooooooooooooo + fooooooooooooooooooooooooooooooooooooooo + fooooooooooooooooooooooooooooooooooooooo + ~f:(fun (type a) foooooooooooooooooooooooooooooooooo : 'a -> + match fooooooooooooooooooooooooooooooooooooooo with + | Fooooooooooooooooooooooooooooooooooooooo -> x + | Fooooooooooooooooooooooooooooooooooooooo -> x) + +let _ = + foo + |> List.map ~f:(fun x -> + do_something (); + do_something (); + do_something (); + do_something (); + do_something_else ()) + +let _ = + foo + |> List.map ~f:(fun x -> + do_something (); + do_something (); + do_something (); + do_something (); + do_something_else ()) + |> bar + +let _ = + foo + |> List.map fooooooooooo fooooooooooo fooooooooooo fooooooooooo fooooooooooo + fooooooooooo fooooooooooo fooooooooooo + +let _ = foo |> List.map (function A -> do_something ()) + +let _ = + foo + |> List.map (function + | A -> do_something () + | A -> do_something () + | A -> do_something () + | A -> do_something () + | A -> do_something_else ()) + |> bar + +let _ = + foo + |> List.double_map + ~f1:(fun x -> + do_something (); + do_something (); + do_something (); + do_something (); + do_something_else ()) + ~f2:(fun x -> + do_something (); + do_something (); + do_something (); + do_something (); + do_something_else ()) + |> bar + +module Stritem_attributes_indent : sig + val f : int -> int -> int -> int -> int + [@@cold] [@@inline never] [@@local never] [@@specialise never] + + external unsafe_memset : t -> pos:int -> len:int -> char -> unit + = "bigstring_memset_stub" + [@@noalloc] +end = struct + let raise_length_mismatch name n1 n2 = + invalid_argf "length mismatch in %s: %d <> %d" name n1 n2 () + [@@cold] [@@inline never] [@@local never] [@@specialise never] + + external unsafe_memset : t -> pos:int -> len:int -> char -> unit + = "bigstring_memset_stub" + [@@noalloc] +end + +let _ = + foo + $$ (match group with + | [] -> impossible "previous match" + | [ cmt ] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt) + $$ bar + +let _ = + foo + $$ (try group with + | [] -> impossible "previous match" + | [ cmt ] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt) + $$ bar + +let _ = + x == exp + || + match x with + | { pexp_desc = Pexp_constraint (e, _); _ } -> loop e + | _ -> false + +let _ = + let module M = struct + include + (val foooooooooooooooooooooooooooooooooooooooo + : fooooooooooooooooooooooooooooooooooooooooo) + end in + () + +type action = + | In_out of [ `Impl | `Intf ] input * string option + (** Format input file (or [-] for stdin) of given kind to output file, or + stdout if None. *) + (* foo *) + | Inplace of [ `Impl | `Intf ] input list + (** Format in-place, overwriting input file(s). *) + +let%test_module "semantics" = + (module ( + struct + open Core + open Appendable_list + module Stable = Stable + end : + S)) + +let _ = + Error + (`Foooooooooooooooooo + (name, Format.sprintf "expecting %S but got %S" Version.version value)) + +let _ = + `Foooooooooooooooooo + (name, Format.sprintf "expecting %S but got %S" Version.version value) + +let _ = + Foooooooooooooooooo + (name, Format.sprintf "expecting %S but got %S" Version.version value) + +let (`Foooooooooooooooooo + (foooooooooooooo, foooooooooooooo, foooooooooooooo, foooooooooooooo)) = + x + +let (Foooooooooooooooooo + (foooooooooooooo, foooooooooooooo, foooooooooooooo, foooooooooooooo)) = + x + +let _ = + Foooooooooooooooooooo.foooooooooooooooooooo foooooooooooooooooooo + foooooooooooooooooooo (fun x -> function + | Foooooooooooooooooooo -> foooooooooooooooooooo + | Foooooooooooooooooooo -> foooooooooooooooooooo) + +let _ = + Foooooooooooooooooooo.foooooooooooooooooooo foooooooooooooooooooo + foooooooooooooooooooo ~x:(fun x -> function + | Foooooooooooooooooooo -> foooooooooooooooooooo + | Foooooooooooooooooooo -> foooooooooooooooooooo) + +let _ = + Foooooooooooooooooooo.foooooooooooooooooooo foooooooooooooooooooo + foooooooooooooooooooo (fun x -> + match foo with + | Foooooooooooooooooooo -> foooooooooooooooooooo + | Foooooooooooooooooooo -> foooooooooooooooooooo) + +let _ = + Foooooooooooooooooooo.foooooooooooooooooooo foooooooooooooooooooo + foooooooooooooooooooo ~x:(fun x -> + match foo with + | Foooooooooooooooooooo -> foooooooooooooooooooo + | Foooooooooooooooooooo -> foooooooooooooooooooo) + +let _ = + let x = x in + fun foooooooooooooooooo foooooooooooooooooo foooooooooooooooooo + foooooooooooooooooo foooooooooooooooooo foooooooooooooooooo -> () + +module type For_let_syntax_local = + For_let_syntax_gen + with type ('a, 'b) fn := ('a[@local]) -> 'b + and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b + +type fooooooooooooooooooooooooooooooo = + ( fooooooooooooooooooooooooooooooo, + fooooooooooooooooooooooooooooooo ) + fooooooooooooooooooooooooooooooo + +val fooooooooooooooooooooooooooooooo : + ( fooooooooooooooooooooooooooooooo, + fooooooooooooooooooooooooooooooo ) + fooooooooooooooooooooooooooooooo + +(* *) + +(** xxx *) +include S1 +(** @inline *) + +type input = { name : string; action : [ `Format | `Numeric of range ] } + +let x = + fun [@foo] x -> + fun [@foo] y -> + object + method x = y + end + +class x = + fun [@foo] x -> + fun [@foo] y -> + object + method x = y + end + +module M = + [%demo + module Foo = Bar + + type t] + +let _ = + Some + (fun fooooooooooooooooooooooooooooooo + fooooooooooooooooooooooooooooooo + fooooooooooooooooooooooooooooooo + -> foo) + +type t = { + xxxxxx : + t + (* _________________________________________________________________________ + ____________________________________________________________________ + ___________ *) + XXXXXXX.t; +} + +module Test_gen + (For_tests : For_tests_gen) + (Tested : + S_gen + with type 'a src := 'a For_tests.Src.t + with type 'a dst := 'a For_tests.Dst.t) + (Tested : + S_gen + with type 'a src := 'a For_tests.Src.t + with type 'a dst := 'a For_tests.Dst.t + and type 'a dst := 'a For_tests.Dst.t + and type 'a dst := 'a For_tests.Dst.t) = +struct + open Tested + open For_tests +end + +type t = { + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : + YYYYYYYYYYYYYYYYYYYYY.t; + (* ____________________________________ *) +} + +(*{v + + foo + +v}*) + +(*$ {| + f|} *) + +type t = { + xxxxxxxxxxxxxxxxxxx : yyy; + [@zzzzzzzzzzzzzzzzzzz + (* ________________________________ + ___ *) + _______] +} + +let _ = + match () with + (*$ Printf.(printf "\n | _ -> .\n;;\n") *) + | _ -> . + +(*$*) + +(*$ "________________________" $*) + +(*$ + let open! Core in + () +*) +(*$*) + +(*$ + [%string + {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +zzzzzzzzzzzzzzzzzzzzzzzzzzzz + |}] +*) +(*$*) + +(*$ {| + f|} *) + +let () = match () with _ -> ( fun _ : _ -> match () with _ -> ()) | _ -> () + +(* ocp-indent-compat: Docked fun after apply only if on the same line. *) + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo:(fun foo -> bar) + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo:(fun foo -> bar) + ~fooooooooooooooooooooooooooooooo + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo:(fun foo -> + match bar with Some _ -> foo | None -> baz) + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo + (fun foo -> bar) + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo + (fun foo -> match bar with Some _ -> foo | None -> baz) + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo (fun foo -> + match bar with Some _ -> foo | None -> baz) + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooofooooooooooooooooooooooooooooooofoooooooooo + (fun foo -> match bar with Some _ -> foo | None -> baz) + +let _ = + fooooooooooooooooooooooooooooooo + |> foooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo (function + | foo -> bar) + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo + (function + | Some _ -> foo + | None -> baz) + +(* *) + +(*$ (* *) *) + +(** xxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx + xxxx] + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx] *) + +(* Hand-aligned comment + . + . *) + +(* First line is indented more + . + . *) + +module type M = sig + val imported_sets_of_closures_table : + Simple_value_approx.function_declarations option + Set_of_closures_id.Tbl.fooooooooooooooooooooooooo +end + +(*$ let _ = [ x (* *); y ] *) + +let _ = + { + foo = + (fun _ -> function + | _ -> + let _ = 42 in + () + | () -> ()); + } + +let _ = + match () with + | _ -> ( + f >>= function + | `Fooooooooooooooooooooooooooooooooooooooo -> 1 + | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> 2) + +let _ = + match () with + | _ -> + f + >>= ( function + | `Fooooooooooooooooooooooooooooooooooooooo -> 1 + | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> 2 ) + >>= foo + +let exists t key = + S.Tree.kind t.tree (path key) >|= function + | Some `Contents -> Ok (Some `Value) + | Some `Node -> Ok (Some `Dictionary) + | None -> Ok None + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w + +let _ = + if x then fun _ -> true + (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + else f + +let _ = + match ids_queue with + | Some q -> + (* this is more efficient than a linear scan of [ids] *) + fun id -> not (Ident.HashQueue.mem q id) + | None -> fun id -> not (List.mem ~equal:Ident.equal ids id) + +type callbacks = { + html_debug_new_node_session_f : + 'a. + ?kind:[ `ComputePre | `ExecNode | `ExecNodeNarrowing | `WTO ] -> + pp_name:(Format.formatter -> unit) -> + Procdesc.Node.t -> + f:(unit -> 'a) -> + 'a; +} diff --git a/test/passing/refs.default/js_syntax.ml.ref b/test/passing/refs.default/js_syntax.ml.ref new file mode 100644 index 0000000000..1e63365915 --- /dev/null +++ b/test/passing/refs.default/js_syntax.ml.ref @@ -0,0 +1,11 @@ +(* s *) + +let _ = + [%raise_structural_sexp + "feature's tip is already an ancestor of new base" + { feature_tip = (old_tip : Rev.t); new_base : Rev.t }] + +let _ = + [%raise_structural_sexp + "feature's tip is already an ancestor of new base" + { feature_tip = (old_tip : Rev.t); new_base : Rev.t }] diff --git a/test/passing/refs.default/js_to_do.ml.err b/test/passing/refs.default/js_to_do.ml.err new file mode 100644 index 0000000000..1981388873 --- /dev/null +++ b/test/passing/refs.default/js_to_do.ml.err @@ -0,0 +1 @@ +Warning: js_to_do.ml:60 exceeds the margin diff --git a/test/passing/refs.default/js_to_do.ml.ref b/test/passing/refs.default/js_to_do.ml.ref new file mode 100644 index 0000000000..584fc308cc --- /dev/null +++ b/test/passing/refs.default/js_to_do.ml.ref @@ -0,0 +1,63 @@ +(* Indentation that Jane Street needs to think about and make precise. + + These are long term ideas, possibly even conflicting with other tests. *) + +(* js-args *) + +let _ = + let min_closing_backoff = + -.(Hidden_float.expose (arb.cfg.base_edge @! Buy) + +. Hidden_float.expose (arb.cfg.base_edge @! Sell)) + in + 0 + +(* js-type *) + +(* The following tests incorporate several subtle and different indentation + ideas. Please consider this only a proposal for discussion, for now. + + First, notice the display treatment of "(,)" tuples, analogous to "[;]" + lists. While "(,)" is an intensional combination of "()" and ",", unlike + "[;]" lists, we believe "(,)" isn't too big a departure. Value expression + analogies are included in js-type.ml, (meant to be) consistent with the + proposed type indentation. + + Second, and more divergently, the proposed indentation of function types is + based on the idea of aligning the arguments, even the first argument, even + where that means automatically inserting spaces within lines. This applies + to the extra spaces in ":__unit" and "(____Config.Network.t" below. + + We believe this fits into a more general incorporation of alignment into + ocp-indent, to replace our internal alignment tool with a syntax-aware one. + We like to align things for readability, like big records, record types, + lists used to build tables, etc. + + The proposal also includes indenting "->" in the circumstances below relative + to the enclosing "()", by two spaces. In a sense, this happens first, and + then the first argument is aligned accordingly. So, there's no manual + indentation or spacing below. *) + +val instances : + unit -> + ( Config.Network.t -> + (App.t * Config.instance * Config.app) list -> + verbose:bool -> + 'm, + 'm ) + Command.Spec.t + +val instances : + unit -> + ( Config.Network.t -> + (App.t * Config.instance * Config.app) list -> + verbose:bool -> + 'm, + 'm ) + Command.Spec.t + +(* presumed analog with stars *) +val instances : + unit + * ( Config.Network.t * (App.t * Config.instance * Config.app) list * bool * 'm, + 'm ) + Command.Spec.t diff --git a/test/passing/refs.default/js_upon.ml.ref b/test/passing/refs.default/js_upon.ml.ref new file mode 100644 index 0000000000..a16f0fa10a --- /dev/null +++ b/test/passing/refs.default/js_upon.ml.ref @@ -0,0 +1,14 @@ +let f x = + stop + (* We don't do this as a matter of style, but the indentation reveals a common + mistake. *) + >>> fun () -> + don't_wait_for (close fd); + bind fd + +let f x = + ( stop + (* This is what was intended, which is indented correctly, although it's bad + style on my part. *) + >>> fun () -> don't_wait_for (close fd) ); + bind diff --git a/test/passing/refs.default/kw_extentions.ml.ref b/test/passing/refs.default/kw_extentions.ml.ref new file mode 100644 index 0000000000..8b20326d7e --- /dev/null +++ b/test/passing/refs.default/kw_extentions.ml.ref @@ -0,0 +1,57 @@ +let _ = + let%lwt foo = Lwt.return 1 in + Lwt.return_unit + +let _ = + let%lwt foo = Lwt.return 1 in + let%lwt bar = Lwt.return 1 in + let%lwt baz = Lwt.return 1 in + Lwt.return_unit + +let () = + if%ext true then () else (); + if%ext true then () else if true then () else (); + let%ext x = () in + for%ext i = 1 to 10 do + () + done; + while%ext false do + () + done; + match%ext x with _ -> () + +let () = + let%ext x = () in + try%ext x with _ -> () + +let () = + if%ext true then () else (); + if%ext true then () else if true then () else (); + if%ext true then () else () + +let () = + (match%ext x with _ -> ()); + match%ext x with _ -> () + +let () = + (); + ();%ext + (); + ();%ext + () + +let _ = + let%ext () = () and () = () in + () + +let () = + f (fun () -> ());%ext + f () + +let () = + f (fun () -> ());%ext + g (fun () -> ()); + h (fun () -> ());%ext + i (); + j ();%ext + f () diff --git a/test/passing/refs.default/label_option_default_args.ml.ref b/test/passing/refs.default/label_option_default_args.ml.ref new file mode 100644 index 0000000000..0944772a10 --- /dev/null +++ b/test/passing/refs.default/label_option_default_args.ml.ref @@ -0,0 +1,105 @@ +let f x = e +let (* 0 *) f (* 1 *) x (* 2 *) = (* 3 *) e +let f ~x = e +let (* 0 *) f (* 1 *) ~x (* 2 *) = (* 3 *) e +let f ~(x : t) = e + +let (* 0 *) f (* 1 *) ~(* 2 *) (x (* 3 *) : (* 4 *) t (* 5 *)) (* 6 *) = + (* 7 *) e + +let f ~l:x = e +let (* 0 *) f (* 1 *) ~l:(* 2 *) x (* 3 *) = (* 4 *) e +let f ~l:{ f; g } = e + +let (* 0 *) f (* 1 *) ~l:(* 2 *) { (* 3 *) f (* 4 *); (* 5 *) g (* 6 *) } + (* 7 *) = + e + +let f ~x:({ f; g } as x) = e + +let (* 0 *) f (* 1 *) ~x:((* 2 *) { f; g } (* 3 *) as (* 4 *) x (* 5 *)) (* 6 *) + = + e + +let f ?x = e +let (* 0 *) f (* 1 *) ?(* 2 *) x (* 3 *) = e +let f ?(x : t) = e +let (* 0 *) f (* 1 *) ?(* 2 *) (x (* 3 *) : (* 4 *) t (* 5 *)) (* 6 *) = e +let f ?l:x = e +let (* 0 *) f (* 1 *) ?l:(* 2 *) x (* 3 *) = e +let f ?l:(C x) = e + +let (* 0 *) f (* 1 *) + ?l: + ((* 2 *) + (* 3 *) C (* 4 *) x (* 5 *)) (* 6 *) = + e + +let f ?(x = d) = e +let (* 0 *) f (* 1 *) ?((* 2 *) x (* 3 *) = (* 4 *) d (* 5 *)) (* 6 *) = e +let f ?(x : t = d) = e + +let (* 0 *) f (* 1 *) + ?((* 2 *) x (* 3 *) : (* 4 *) t (* 5 *) = (* 6 *) d (* 7 *)) (* 8 *) = + e + +let f ?(x = (d : t)) = e + +let (* 0 *) f (* 1 *) + ?((* 2 *) x (* 3 *) = + (* 4 *) ((* 5 *) d (* 6 *) : (* 7 *) t (* 8 *)) (* 9 *)) (* 10 *) = + e + +let f ?l:(x = d) = e +let f ?l:(x = (d : t)) = e +let f ?l:(x : t = d) = e + +let (* 0 *) f (* 1 *) + ?l: + ((* 2 *) + (* 3 *) + x (* 4 *) : (* 5 *) t (* 6 *) = (* 7 *) d (* 8 *)) (* 9 *) = + e + +let f ?l:(C x = d) = e + +let (* 0 *) f (* 1 *) + ?l: + ((* 2 *) + (* 3 *) + C (* 4 *) x (* 5 *) = (* 6 *) d (* 7 *)) (* 8 *) = + e + +(* Regression tests for https://github.com/ocaml-ppx/ocamlformat/issues/1260 + (optional argument rebound to non-variable without necessary parens). *) + +(* Safe without parens *) +let f ?any:_ = () +let f ?var:a = () + +(* Requires parens *) +let f ?alias:(_ as b) = () +let f ?constant:(0) = () +let f ?interval:('a' .. 'z') = () +let f ?tuple:(1, 2) = () +let f ?construct1:(A) ?construct2:(()) ?construct3:(Some ()) = () +let f ?variant:(`A ()) = () +let f ?record:({ a; b }) = () +let f ?array:([| 1; 2; 3 |]) = () +let f ?or_:(Some () | None) = () +let f ?constraint_:(() : unit) = () +let f ?type_:(#tconst) = () +let f ?lazy_:(lazy ()) = () +let f ?extension:([%ext]) = () +let f ?open_:(Int.(zero)) = () + +(* Requires two pairs of parens *) +let f ?unpack:((module P)) = () + +(* May need extra parens to handle attributes *) +let f ?any:(_ [@attr]) = () +let f ?constant:(0 [@attr]) = () +let f ?open_:(Int.(zero) [@attr]) = () +let f ?or_:((Some () | None) [@attr]) = () +let f ?unpack:((module P) [@attr]) = () +let f ?tuple:((1, 2) [@attr]) = () diff --git a/test/passing/refs.default/labelled_args-414.ml.ref b/test/passing/refs.default/labelled_args-414.ml.ref new file mode 100644 index 0000000000..04335b8845 --- /dev/null +++ b/test/passing/refs.default/labelled_args-414.ml.ref @@ -0,0 +1,39 @@ +let _ = + let f ~y = y + 1 in + f ~(y : int) + +let () = + very_long_function_name + ~very_long_argument_label:(fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> ()) + +let () = + very_long_function_name + ~very_long_argument_label:(* foo *) + (fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> ()) + +let () = + very_long_function_name + ~very_long_argument_label:(fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> ()) + foo + +let () = + very_long_function_name + ~very_long_argument_label:(* foo *) + (fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> ()) + foo diff --git a/test/passing/refs.default/labelled_args.ml.ref b/test/passing/refs.default/labelled_args.ml.ref new file mode 100644 index 0000000000..cdcaa463cc --- /dev/null +++ b/test/passing/refs.default/labelled_args.ml.ref @@ -0,0 +1,39 @@ +let _ = + let f ~y = y + 1 in + f ~y:(y : int) + +let () = + very_long_function_name + ~very_long_argument_label:(fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> ()) + +let () = + very_long_function_name + ~very_long_argument_label:(* foo *) + (fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> ()) + +let () = + very_long_function_name + ~very_long_argument_label:(fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> ()) + foo + +let () = + very_long_function_name + ~very_long_argument_label:(* foo *) + (fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> ()) + foo diff --git a/test/passing/refs.default/lazy.ml.ref b/test/passing/refs.default/lazy.ml.ref new file mode 100644 index 0000000000..e493842097 --- /dev/null +++ b/test/passing/refs.default/lazy.ml.ref @@ -0,0 +1,16 @@ +let (lazy a) = lazy 1 +let (lazy (a, b)) = lazy (1, 2) + +let () = + let (lazy a) = lazy 1 in + let (lazy (a, b)) = lazy (1, 2) in + () + +let _ = lazy (a.b <- 1) +let _ = match x with (lazy (Some _ as x)), x -> x + +let _ = + lazy + ((let () = () in + ()) + [@attr]) diff --git a/test/passing/refs.default/let_binding-deindent-fun.ml.ref b/test/passing/refs.default/let_binding-deindent-fun.ml.ref new file mode 100644 index 0000000000..f2c21f72f7 --- /dev/null +++ b/test/passing/refs.default/let_binding-deindent-fun.ml.ref @@ -0,0 +1,264 @@ +(* Note that {[ let ident : typ = exp ]} is different from {[ let (ident : + typ) = exp ]}. The difference should be maintained *) + +let (_ : int) = x1 +let (x : int) = x2 +let (_ : int) = x3 +let x : int = x4 + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + () + +let%ext (_ : int) = x1 +let%ext (x : int) = x2 +let%ext (_ : int) = x3 +let%ext x : int = x4 + +let%ext _ = + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext (_ : int) = x in + () + +let [%ext let x = 3] = 2 +let [%ext: [%exp let x = 3]] = 2 +let f : 'a. 'a ty -> 'a = fun y -> g y +let f (A _ | B | C) = () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ | BBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa + ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe | FFFFFFFFFFFFFFFFFFFFFFFFFFf + | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) + | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + () + +let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () +let f = function AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () +let f = function EEEEEEE | F | GGGGG | B | CCCCCCC -> () + +let f = function + | EEEEEEE | FFFFFFFFFFFFFFFFFFFFFFF | GGGGG + | BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb | CCCCCCC -> + () + +let (_ : t -> t -> int) = (compare : int list -> int list -> int) + +let _ = + let[@test] rec f = x in + y + +module Let_and_compact = struct + [@@@ocamlformat "let-and=compact"] + + let x = 2 + and y = 2 + + let _ = + let x = 2 and y = 2 in + 3 + + let _ = + let%ext x = 2 and y = 2 in + 3 +end + +module Let_and_sparse = struct + [@@@ocamlformat "let-and=sparse"] + + let x = 2 + and y = 2 + + let _ = + let x = 2 + and y = 2 in + 3 + + let _ = + let%ext x = 2 + and y = 2 in + 3 +end + +let f aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc + dddddddddddddddddd eeeeeeeeeeeeee = + () + +let _ = + fun aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc + dddddddddddddddddd eeeeeeeeeeeeee -> + () + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext _ : int = x in + () + +let fooo = fooooooooooo [@@foo] + +let fooo = fooooooooooo [@@foo] +and fooo = fooooooooooo [@@foo] +;; + +let foooo = fooooooooo [@@foo] in +fooooooooooooooooooooo + +let[@foo] fooo = fooooooooooo + +let[@foo] fooo = fooooooooooo +and[@foo] fooo = fooooooooooo +;; + +let[@foo] foooo = fooooooooo in +fooooooooooooooooooooo + +let a : int = 0 +let b = (0 : int) + +let _ = + let+ a = b in + c + +let _ = + let+ a = b and+ c = d in + e + +let _ = + if true then a + else + let+ a = b in + c + +let _ = + if true then + let+ a = b in + c + else d + +let _ = + match a with + | a -> ( + match a with + | a -> ( + let+ a = b in + match a with a -> a)) + +let _ = + match a with + | a -> ( + match a with + | a -> ( + let+ a = b in + match a with a -> a) + | b -> c) + +let _ = + let+ a b = c in + d + +let _ = + f + (let+ a b = c in + d) + +let () = + let* x = 1 (* blah *) and* y = 2 in + () + +let x = () +(* after x *) + +let y = () + +let x = () +(* after x *) + +and y = () + +(** doc x *) +let x = () [@@foo] +(* after x *) + +(** doc y *) +let y = () [@@foo] +(* after y *) + +(** doc x *) +let x = () +(* after x *) + +(** doc y *) +and y = () [@@foo] +(* after y *) + +let _ = + let* () = + (* xxx *) + xxx + and* () = + (* yyy *) + yyy + in + zzz + +[@@@ocamlformat "let-binding-spacing=double-semicolon"] + +module A = struct + let f : int S.t ab -> float S.t ab -> string = + fun (l : int S.t ab) (r : float S.t ab) -> + match (l, r) with A, B -> "f A B" + ;; +end + +let (A (a, _, b) | B (b, a)) = A (1, 2, 3) + +let copy from ~into : unit = + let ({ + pulse_captured_vars_length_contradictions; + pulse_summaries_count; + topl_reachable_calls; + timeouts; + timings; + } [@warning "+9"]) = + () + in + () +;; + +let { x; y } : foo = bar +let ({ x; y } : foo) = bar +let a, b = (raise Exit : int * int) +let a, b = (raise Exit : int * int) + +let _ = + fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> + match () with _ -> () +;; + +fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> + match () with _ -> () + +let _ = + (* + An alternative would be to track 'mutability of the field' + directly. + *) + function + | Strict | Alias -> Immutable + | StrictOpt -> Mutable +;; diff --git a/test/passing/refs.default/let_binding-in_indent.ml.ref b/test/passing/refs.default/let_binding-in_indent.ml.ref new file mode 100644 index 0000000000..27eb4ab87c --- /dev/null +++ b/test/passing/refs.default/let_binding-in_indent.ml.ref @@ -0,0 +1,264 @@ +(* Note that {[ let ident : typ = exp ]} is different from {[ let (ident : + typ) = exp ]}. The difference should be maintained *) + +let (_ : int) = x1 +let (x : int) = x2 +let (_ : int) = x3 +let x : int = x4 + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + () + +let%ext (_ : int) = x1 +let%ext (x : int) = x2 +let%ext (_ : int) = x3 +let%ext x : int = x4 + +let%ext _ = + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext (_ : int) = x in + () + +let [%ext let x = 3] = 2 +let [%ext: [%exp let x = 3]] = 2 +let f : 'a. 'a ty -> 'a = fun y -> g y +let f (A _ | B | C) = () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ | BBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa + ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe | FFFFFFFFFFFFFFFFFFFFFFFFFFf + | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) + | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + () + +let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () +let f = function AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () +let f = function EEEEEEE | F | GGGGG | B | CCCCCCC -> () + +let f = function + | EEEEEEE | FFFFFFFFFFFFFFFFFFFFFFF | GGGGG + | BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb | CCCCCCC -> + () + +let (_ : t -> t -> int) = (compare : int list -> int list -> int) + +let _ = + let[@test] rec f = x in + y + +module Let_and_compact = struct + [@@@ocamlformat "let-and=compact"] + + let x = 2 + and y = 2 + + let _ = + let x = 2 and y = 2 in + 3 + + let _ = + let%ext x = 2 and y = 2 in + 3 +end + +module Let_and_sparse = struct + [@@@ocamlformat "let-and=sparse"] + + let x = 2 + and y = 2 + + let _ = + let x = 2 + and y = 2 in + 3 + + let _ = + let%ext x = 2 + and y = 2 in + 3 +end + +let f aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc + dddddddddddddddddd eeeeeeeeeeeeee = + () + +let _ = + fun aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc + dddddddddddddddddd eeeeeeeeeeeeee -> + () + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext _ : int = x in + () + +let fooo = fooooooooooo [@@foo] + +let fooo = fooooooooooo [@@foo] +and fooo = fooooooooooo [@@foo] +;; + +let foooo = fooooooooo [@@foo] in + fooooooooooooooooooooo + +let[@foo] fooo = fooooooooooo + +let[@foo] fooo = fooooooooooo +and[@foo] fooo = fooooooooooo +;; + +let[@foo] foooo = fooooooooo in + fooooooooooooooooooooo + +let a : int = 0 +let b = (0 : int) + +let _ = + let+ a = b in + c + +let _ = + let+ a = b and+ c = d in + e + +let _ = + if true then a + else + let+ a = b in + c + +let _ = + if true then + let+ a = b in + c + else d + +let _ = + match a with + | a -> ( + match a with + | a -> ( + let+ a = b in + match a with a -> a)) + +let _ = + match a with + | a -> ( + match a with + | a -> ( + let+ a = b in + match a with a -> a) + | b -> c) + +let _ = + let+ a b = c in + d + +let _ = + f + (let+ a b = c in + d) + +let () = + let* x = 1 (* blah *) and* y = 2 in + () + +let x = () +(* after x *) + +let y = () + +let x = () +(* after x *) + +and y = () + +(** doc x *) +let x = () [@@foo] +(* after x *) + +(** doc y *) +let y = () [@@foo] +(* after y *) + +(** doc x *) +let x = () +(* after x *) + +(** doc y *) +and y = () [@@foo] +(* after y *) + +let _ = + let* () = + (* xxx *) + xxx + and* () = + (* yyy *) + yyy + in + zzz + +[@@@ocamlformat "let-binding-spacing=double-semicolon"] + +module A = struct + let f : int S.t ab -> float S.t ab -> string = + fun (l : int S.t ab) (r : float S.t ab) -> + match (l, r) with A, B -> "f A B" + ;; +end + +let (A (a, _, b) | B (b, a)) = A (1, 2, 3) + +let copy from ~into : unit = + let ({ + pulse_captured_vars_length_contradictions; + pulse_summaries_count; + topl_reachable_calls; + timeouts; + timings; + } [@warning "+9"]) = + () + in + () +;; + +let { x; y } : foo = bar +let ({ x; y } : foo) = bar +let a, b = (raise Exit : int * int) +let a, b = (raise Exit : int * int) + +let _ = + fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> + match () with _ -> () +;; + +fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> + match () with _ -> () + +let _ = + (* + An alternative would be to track 'mutability of the field' + directly. + *) + function + | Strict | Alias -> Immutable + | StrictOpt -> Mutable +;; diff --git a/test/passing/refs.default/let_binding-indent.ml.ref b/test/passing/refs.default/let_binding-indent.ml.ref new file mode 100644 index 0000000000..81f704d433 --- /dev/null +++ b/test/passing/refs.default/let_binding-indent.ml.ref @@ -0,0 +1,265 @@ +(* Note that {[ let ident : typ = exp ]} is different from {[ let (ident : + typ) = exp ]}. The difference should be maintained *) + +let (_ : int) = x1 +let (x : int) = x2 +let (_ : int) = x3 +let x : int = x4 + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + () + +let%ext (_ : int) = x1 +let%ext (x : int) = x2 +let%ext (_ : int) = x3 +let%ext x : int = x4 + +let%ext _ = + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext (_ : int) = x in + () + +let [%ext let x = 3] = 2 +let [%ext: [%exp let x = 3]] = 2 +let f : 'a. 'a ty -> 'a = fun y -> g y +let f (A _ | B | C) = () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ | BBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa + ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe | FFFFFFFFFFFFFFFFFFFFFFFFFFf + | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) + | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + () + +let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () +let f = function AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () +let f = function EEEEEEE | F | GGGGG | B | CCCCCCC -> () + +let f = function + | EEEEEEE | FFFFFFFFFFFFFFFFFFFFFFF | GGGGG + | BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb | CCCCCCC -> + () + +let (_ : t -> t -> int) = (compare : int list -> int list -> int) + +let _ = + let[@test] rec f = x in + y + +module Let_and_compact = struct + [@@@ocamlformat "let-and=compact"] + + let x = 2 + and y = 2 + + let _ = + let x = 2 and y = 2 in + 3 + + let _ = + let%ext x = 2 and y = 2 in + 3 +end + +module Let_and_sparse = struct + [@@@ocamlformat "let-and=sparse"] + + let x = 2 + and y = 2 + + let _ = + let x = 2 + and y = 2 in + 3 + + let _ = + let%ext x = 2 + and y = 2 in + 3 +end + +let f aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc + dddddddddddddddddd eeeeeeeeeeeeee = + () + +let _ = + fun aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc + dddddddddddddddddd eeeeeeeeeeeeee -> + () + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext _ : int = x in + () + +let fooo = fooooooooooo [@@foo] + +let fooo = fooooooooooo [@@foo] +and fooo = fooooooooooo [@@foo] +;; + +let foooo = fooooooooo [@@foo] in +fooooooooooooooooooooo + +let[@foo] fooo = fooooooooooo + +let[@foo] fooo = fooooooooooo +and[@foo] fooo = fooooooooooo +;; + +let[@foo] foooo = fooooooooo in +fooooooooooooooooooooo + +let a : int = 0 +let b = (0 : int) + +let _ = + let+ a = b in + c + +let _ = + let+ a = b and+ c = d in + e + +let _ = + if true then a + else + let+ a = b in + c + +let _ = + if true then + let+ a = b in + c + else d + +let _ = + match a with + | a -> ( + match a with + | a -> ( + let+ a = b in + match a with a -> a)) + +let _ = + match a with + | a -> ( + match a with + | a -> ( + let+ a = b in + match a with a -> a) + | b -> c) + +let _ = + let+ a b = c in + d + +let _ = + f + (let+ a b = c in + d) + +let () = + let* x = 1 (* blah *) and* y = 2 in + () + +let x = () +(* after x *) + +let y = () + +let x = () +(* after x *) + +and y = () + +(** doc x *) +let x = () [@@foo] +(* after x *) + +(** doc y *) +let y = () [@@foo] +(* after y *) + +(** doc x *) +let x = () +(* after x *) + +(** doc y *) +and y = () [@@foo] +(* after y *) + +let _ = + let* () = + (* xxx *) + xxx + and* () = + (* yyy *) + yyy + in + zzz + +[@@@ocamlformat "let-binding-spacing=double-semicolon"] + +module A = struct + let f : int S.t ab -> float S.t ab -> string = + fun (l : int S.t ab) (r : float S.t ab) -> + match (l, r) with A, B -> "f A B" + ;; +end + +let (A (a, _, b) | B (b, a)) = A (1, 2, 3) + +let copy from ~into : unit = + let ({ + pulse_captured_vars_length_contradictions; + pulse_summaries_count; + topl_reachable_calls; + timeouts; + timings; + } [@warning "+9"]) = + () + in + () +;; + +let { x; y } : foo = bar +let ({ x; y } : foo) = bar +let a, b = (raise Exit : int * int) +let a, b = (raise Exit : int * int) + +let _ = + fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : + _ -> + match () with _ -> () +;; + +fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> + match () with _ -> () + +let _ = + (* + An alternative would be to track 'mutability of the field' + directly. + *) + function + | Strict | Alias -> Immutable + | StrictOpt -> Mutable +;; diff --git a/test/passing/refs.default/let_binding.ml.ref b/test/passing/refs.default/let_binding.ml.ref new file mode 100644 index 0000000000..811259dc64 --- /dev/null +++ b/test/passing/refs.default/let_binding.ml.ref @@ -0,0 +1,264 @@ +(* Note that {[ let ident : typ = exp ]} is different from {[ let (ident : + typ) = exp ]}. The difference should be maintained *) + +let (_ : int) = x1 +let (x : int) = x2 +let (_ : int) = x3 +let x : int = x4 + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + () + +let%ext (_ : int) = x1 +let%ext (x : int) = x2 +let%ext (_ : int) = x3 +let%ext x : int = x4 + +let%ext _ = + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext (_ : int) = x in + () + +let [%ext let x = 3] = 2 +let [%ext: [%exp let x = 3]] = 2 +let f : 'a. 'a ty -> 'a = fun y -> g y +let f (A _ | B | C) = () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ | BBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa + ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe | FFFFFFFFFFFFFFFFFFFFFFFFFFf + | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) + | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + () + +let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () +let f = function AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () +let f = function EEEEEEE | F | GGGGG | B | CCCCCCC -> () + +let f = function + | EEEEEEE | FFFFFFFFFFFFFFFFFFFFFFF | GGGGG + | BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb | CCCCCCC -> + () + +let (_ : t -> t -> int) = (compare : int list -> int list -> int) + +let _ = + let[@test] rec f = x in + y + +module Let_and_compact = struct + [@@@ocamlformat "let-and=compact"] + + let x = 2 + and y = 2 + + let _ = + let x = 2 and y = 2 in + 3 + + let _ = + let%ext x = 2 and y = 2 in + 3 +end + +module Let_and_sparse = struct + [@@@ocamlformat "let-and=sparse"] + + let x = 2 + and y = 2 + + let _ = + let x = 2 + and y = 2 in + 3 + + let _ = + let%ext x = 2 + and y = 2 in + 3 +end + +let f aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc + dddddddddddddddddd eeeeeeeeeeeeee = + () + +let _ = + fun aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc + dddddddddddddddddd eeeeeeeeeeeeee -> + () + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext _ : int = x in + () + +let fooo = fooooooooooo [@@foo] + +let fooo = fooooooooooo [@@foo] +and fooo = fooooooooooo [@@foo] +;; + +let foooo = fooooooooo [@@foo] in +fooooooooooooooooooooo + +let[@foo] fooo = fooooooooooo + +let[@foo] fooo = fooooooooooo +and[@foo] fooo = fooooooooooo +;; + +let[@foo] foooo = fooooooooo in +fooooooooooooooooooooo + +let a : int = 0 +let b = (0 : int) + +let _ = + let+ a = b in + c + +let _ = + let+ a = b and+ c = d in + e + +let _ = + if true then a + else + let+ a = b in + c + +let _ = + if true then + let+ a = b in + c + else d + +let _ = + match a with + | a -> ( + match a with + | a -> ( + let+ a = b in + match a with a -> a)) + +let _ = + match a with + | a -> ( + match a with + | a -> ( + let+ a = b in + match a with a -> a) + | b -> c) + +let _ = + let+ a b = c in + d + +let _ = + f + (let+ a b = c in + d) + +let () = + let* x = 1 (* blah *) and* y = 2 in + () + +let x = () +(* after x *) + +let y = () + +let x = () +(* after x *) + +and y = () + +(** doc x *) +let x = () [@@foo] +(* after x *) + +(** doc y *) +let y = () [@@foo] +(* after y *) + +(** doc x *) +let x = () +(* after x *) + +(** doc y *) +and y = () [@@foo] +(* after y *) + +let _ = + let* () = + (* xxx *) + xxx + and* () = + (* yyy *) + yyy + in + zzz + +[@@@ocamlformat "let-binding-spacing=double-semicolon"] + +module A = struct + let f : int S.t ab -> float S.t ab -> string = + fun (l : int S.t ab) (r : float S.t ab) -> + match (l, r) with A, B -> "f A B" + ;; +end + +let (A (a, _, b) | B (b, a)) = A (1, 2, 3) + +let copy from ~into : unit = + let ({ + pulse_captured_vars_length_contradictions; + pulse_summaries_count; + topl_reachable_calls; + timeouts; + timings; + } [@warning "+9"]) = + () + in + () +;; + +let { x; y } : foo = bar +let ({ x; y } : foo) = bar +let a, b = (raise Exit : int * int) +let a, b = (raise Exit : int * int) + +let _ = + fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> + match () with _ -> () +;; + +fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> + match () with _ -> () + +let _ = + (* + An alternative would be to track 'mutability of the field' + directly. + *) + function + | Strict | Alias -> Immutable + | StrictOpt -> Mutable +;; diff --git a/test/passing/refs.default/let_binding_spacing-double-semicolon.ml.ref b/test/passing/refs.default/let_binding_spacing-double-semicolon.ml.ref new file mode 100644 index 0000000000..99deb2ae11 --- /dev/null +++ b/test/passing/refs.default/let_binding_spacing-double-semicolon.ml.ref @@ -0,0 +1,17 @@ +let f x = x +and g x = x + +let f x = x +and g : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = fun h a b -> h + +and g : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = + fun h a b -> h (i a) (i b) (i c) +;; + +let f x = x + +let f : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = + fun h a b -> h (i a) (i b) (i c) +;; + +let f x = x diff --git a/test/passing/refs.default/let_binding_spacing-sparse.ml.ref b/test/passing/refs.default/let_binding_spacing-sparse.ml.ref new file mode 100644 index 0000000000..ed05334e48 --- /dev/null +++ b/test/passing/refs.default/let_binding_spacing-sparse.ml.ref @@ -0,0 +1,17 @@ +let f x = x +and g x = x + +let f x = x +and g : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = fun h a b -> h + +and g : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = + fun h a b -> h (i a) (i b) (i c) + + +let f x = x + +let f : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = + fun h a b -> h (i a) (i b) (i c) + + +let f x = x diff --git a/test/passing/refs.default/let_binding_spacing.ml.ref b/test/passing/refs.default/let_binding_spacing.ml.ref new file mode 100644 index 0000000000..e1688857c4 --- /dev/null +++ b/test/passing/refs.default/let_binding_spacing.ml.ref @@ -0,0 +1,15 @@ +let f x = x +and g x = x + +let f x = x +and g : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = fun h a b -> h + +and g : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = + fun h a b -> h (i a) (i b) (i c) + +let f x = x + +let f : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = + fun h a b -> h (i a) (i b) (i c) + +let f x = x diff --git a/test/passing/refs.default/let_in_constr.ml.ref b/test/passing/refs.default/let_in_constr.ml.ref new file mode 100644 index 0000000000..6bd2dcc2fc --- /dev/null +++ b/test/passing/refs.default/let_in_constr.ml.ref @@ -0,0 +1,4 @@ +let _ = + Some + (let open! List in + 1) diff --git a/test/passing/refs.default/let_module-sparse.ml.ref b/test/passing/refs.default/let_module-sparse.ml.ref new file mode 100644 index 0000000000..e0ce8297c7 --- /dev/null +++ b/test/passing/refs.default/let_module-sparse.ml.ref @@ -0,0 +1,72 @@ +let () = + let module X = + Map.Make (struct + type t = t + + let compare = compare + end) + in + foo + +let () = + let module X = + Map.Make (struct + type t = t + end) + [@foo] + in + let module K = Foooooooooo in + (* foooooo *) + let module X = + Map.Make (struct + type t = t (* foooooooooo *) + end) + [@foo] + in + let module T = X [@foo] in + let module X = + Fooo (struct + type t = t + end) + in + foo + +let () = + let module X = + Map.Make + (struct + type t = t + end) + (* foooooooooooooo *) + (struct + type t = t + type t = t + type t = t + type t = t + end) + (struct + type t = t + type t = t + end) + in + foo + +let f () = + let module (* comment *) M = struct end in + () + +let f () = + let module + (* comment *) + M = + struct end in + () + +let f () = + let module + (* multi-line + + comment *) + M = + struct end in + () diff --git a/test/passing/refs.default/let_module.ml.ref b/test/passing/refs.default/let_module.ml.ref new file mode 100644 index 0000000000..7ecd2f8b71 --- /dev/null +++ b/test/passing/refs.default/let_module.ml.ref @@ -0,0 +1,64 @@ +let () = + let module X = Map.Make (struct + type t = t + + let compare = compare + end) in + foo + +let () = + let module X = Map.Make (struct + type t = t + end) + [@foo] in + let module K = Foooooooooo in + (* foooooo *) + let module X = Map.Make (struct + type t = t (* foooooooooo *) + end) + [@foo] in + let module T = X [@foo] in + let module X = Fooo (struct + type t = t + end) in + foo + +let () = + let module X = + Map.Make + (struct + type t = t + end) + (* foooooooooooooo *) + (struct + type t = t + type t = t + type t = t + type t = t + end) + (struct + type t = t + type t = t + end) + in + foo + +let f () = + let module (* comment *) M = struct end in + () + +let f () = + let module + (* comment *) + M = + struct end in + () + +let f () = + let module + (* multi-line + + comment *) + M = + struct end in + () diff --git a/test/passing/refs.default/let_punning.ml.ref b/test/passing/refs.default/let_punning.ml.ref new file mode 100644 index 0000000000..ddcd8b43ab --- /dev/null +++ b/test/passing/refs.default/let_punning.ml.ref @@ -0,0 +1,14 @@ +let ( let* ) x f = f x +let ( and* ) a b = (a, b) + +let x = 1 +and y = 2 +and z = 3 + +let p = + let* x = x and* y = y and* z = z in + (x, y, z) + +let q = + let%foo x = x and y = y and z = z in + (x, y, z) diff --git a/test/passing/refs.default/line_directives.ml.err b/test/passing/refs.default/line_directives.ml.err new file mode 100644 index 0000000000..45382a4f00 --- /dev/null +++ b/test/passing/refs.default/line_directives.ml.err @@ -0,0 +1,5 @@ +ocamlformat: ignoring "line_directives.ml" (syntax error) +File "line_directives.ml", line 1, characters 1-9: +1 | #3 "f.ml" + ^^^^^^^^ +Error: Invalid lexer directive "#3 \"f.ml\"": line directives are not supported diff --git a/test/passing/refs.default/list-space_around.ml.ref b/test/passing/refs.default/list-space_around.ml.ref new file mode 100644 index 0000000000..bf6e6224c4 --- /dev/null +++ b/test/passing/refs.default/list-space_around.ml.ref @@ -0,0 +1,83 @@ +let f x = match x with P ({ xxxxxx } :: { yyyyyyyy } :: zzzzzzz) -> true + +let f x = + match x with + | P + ({ xxxxxxxxxxxxxxxxxxxxxx } + :: { yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy } + :: zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz) -> + true + +let f x = match x with P [ { xxxxxx }; { yyyyyyyy } ] -> true +let x = (x :: y) :: z +let x = match x with (x :: y) :: z -> () +let _ = [ a; b; c ] +let _ = match x with Atom x -> x | List [ Atom x; Atom y ] -> x ^ y +let _ = match x with Atom x -> x | List (Atom x :: Atom y :: rest) -> x ^ y +let _ = match x with (x :: y) :: z -> true + +let x = function + | [ + "Lorem ipsum dolor sit amet, consectetur adipiscing elit"; + [ + "Lorem ipsum dolor sit amet, consectetur adipiscing elit"; + (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *); + ]; + (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *); + ] -> + () + +[@@@ocamlformat "space-around-lists=true"] + +let x = function + | [ + "Lorem ipsum dolor sit amet, consectetur adipiscing elit"; + [ + "Lorem ipsum dolor sit amet, consectetur adipiscing elit"; + (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *); + ]; + (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *); + ] -> + () + | [ + [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" ]; + (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *); + ] -> + () + +let _ = f (* A *) ~x:(a :: b) (* B *) ~y +let _ = f (* A *) ~x:((* B *) a :: b (* C *)) (* D *) ~y +let _ = f ~x:((* A *) a (* B *) :: (* C *) b (* D *) :: (* E *) c (* F *)) ~y +let _ = f ((* A *) x (* B *) :: (* C *) y (* D *) :: (* E *) z (* F *)) +let _ = abc :: (* def :: *) ghi :: jkl +let _ = abc :: def (* :: ghi *) :: jkl +let _ = (c :: l1) @ foo (l2 @ l) + +let _ = + make_single_trace create_loc message + :: make_single_trace create_loc create_message + :: List.map call_chain ~f:(fun foooooooooooooooooooooooooooo -> + fooooooooooooooooooooooooooooooo foooooooooooo []) + :: foooooooo :: fooooooooooooooooo + +let _ = + fooooooo + (mk_var i (tfo_combine (nuc_p_o3'_60_tfo n) align) n + :: mk_var i (tfo_combine (nuc_p_o3'_180_tfo n) align) n + :: mk_var i (tfo_combine (nuc_p_o3'_275_tfo n) align) n + :: domains) diff --git a/test/passing/refs.default/list.ml.ref b/test/passing/refs.default/list.ml.ref new file mode 100644 index 0000000000..bf6e6224c4 --- /dev/null +++ b/test/passing/refs.default/list.ml.ref @@ -0,0 +1,83 @@ +let f x = match x with P ({ xxxxxx } :: { yyyyyyyy } :: zzzzzzz) -> true + +let f x = + match x with + | P + ({ xxxxxxxxxxxxxxxxxxxxxx } + :: { yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy } + :: zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz) -> + true + +let f x = match x with P [ { xxxxxx }; { yyyyyyyy } ] -> true +let x = (x :: y) :: z +let x = match x with (x :: y) :: z -> () +let _ = [ a; b; c ] +let _ = match x with Atom x -> x | List [ Atom x; Atom y ] -> x ^ y +let _ = match x with Atom x -> x | List (Atom x :: Atom y :: rest) -> x ^ y +let _ = match x with (x :: y) :: z -> true + +let x = function + | [ + "Lorem ipsum dolor sit amet, consectetur adipiscing elit"; + [ + "Lorem ipsum dolor sit amet, consectetur adipiscing elit"; + (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *); + ]; + (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *); + ] -> + () + +[@@@ocamlformat "space-around-lists=true"] + +let x = function + | [ + "Lorem ipsum dolor sit amet, consectetur adipiscing elit"; + [ + "Lorem ipsum dolor sit amet, consectetur adipiscing elit"; + (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *); + ]; + (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *); + ] -> + () + | [ + [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" ]; + (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *); + ] -> + () + +let _ = f (* A *) ~x:(a :: b) (* B *) ~y +let _ = f (* A *) ~x:((* B *) a :: b (* C *)) (* D *) ~y +let _ = f ~x:((* A *) a (* B *) :: (* C *) b (* D *) :: (* E *) c (* F *)) ~y +let _ = f ((* A *) x (* B *) :: (* C *) y (* D *) :: (* E *) z (* F *)) +let _ = abc :: (* def :: *) ghi :: jkl +let _ = abc :: def (* :: ghi *) :: jkl +let _ = (c :: l1) @ foo (l2 @ l) + +let _ = + make_single_trace create_loc message + :: make_single_trace create_loc create_message + :: List.map call_chain ~f:(fun foooooooooooooooooooooooooooo -> + fooooooooooooooooooooooooooooooo foooooooooooo []) + :: foooooooo :: fooooooooooooooooo + +let _ = + fooooooo + (mk_var i (tfo_combine (nuc_p_o3'_60_tfo n) align) n + :: mk_var i (tfo_combine (nuc_p_o3'_180_tfo n) align) n + :: mk_var i (tfo_combine (nuc_p_o3'_275_tfo n) align) n + :: domains) diff --git a/test/passing/refs.default/list_and_comments.ml.ref b/test/passing/refs.default/list_and_comments.ml.ref new file mode 100644 index 0000000000..172912090b --- /dev/null +++ b/test/passing/refs.default/list_and_comments.ml.ref @@ -0,0 +1 @@ +[ 1; (* one *) 2 (* two *) ] diff --git a/test/passing/refs.default/list_normalized.ml.ref b/test/passing/refs.default/list_normalized.ml.ref new file mode 100644 index 0000000000..194e1a0fb7 --- /dev/null +++ b/test/passing/refs.default/list_normalized.ml.ref @@ -0,0 +1,52 @@ +let x = [ 1; 2; 3; 4 ] + +(* comments may move during normalization *) +let x = + (* a *) + [ + 1 (* b *); + (* c *) + 2; + 3; + 4 + (* d *) + (* e *); + ] +(* f *) + +(* comments preserved when the normalization cannot be done (attributes) *) +let x = (* a *) 1 (* b *) :: (* c *) 2 :: 3 :: 4 (* d *) :: (* e *) ([] [@attr]) +(* f *) + +(* comments preserved when no normalization required *) +let x = (* a *) [ (* b *) 1 (* c *); (* d *) 2; 3; 4 (* e *) ] (* f *) +let (x :: []) = e +let (x :: y) = e +let [ x; y ] = e +let (x :: y :: ([] [@attr])) = e +let [ x; (y [@attr]) ] = e +let (*a*) (x (*b*) :: (*c*) y (*d*)) = e + +let + (*a*) + [ + x (*b*); + (*c*) + y + (*d*) + (*e*); + ] (*f*) = + e + +let (*a*) (x (*b*) :: (*c*) y (*d*) :: (*e*) ([] [@attr])) (*f*) = e + +let + (*a*) + [ + x (*b*); + (*c*) + (y [@attr]) + (*d*) + (*e*); + ] (*f*) = + e diff --git a/test/passing/refs.default/loc_stack.ml.ref b/test/passing/refs.default/loc_stack.ml.ref new file mode 100644 index 0000000000..f6959f70d6 --- /dev/null +++ b/test/passing/refs.default/loc_stack.ml.ref @@ -0,0 +1,33 @@ +let _ = + (* a *) + (* b *) + 2 + +let _ = + (* before match *) + match (* after match *) x with + | _ -> 1 + +let _ = + (* before try *) + try (* after try *) x with _ -> 1 + +let should_inline : Llvm.llvalue -> bool = + fun llv -> + match Llvm.use_begin llv with + | Some use -> ( + match Llvm.use_succ use with + | Some _ -> ( + (* If we are not in the default context, we can only use the OCAMLPATH + variable if it is specific to this build context *) + (* CR-someday diml: maybe we should actually clear OCAMLPATH in other + build contexts *) + match Llvm.classify_value llv with + | Instruction + ( Trunc | ZExt | SExt | FPToUI | FPToSI | UIToFP | SIToFP + | FPTrunc | FPExt | PtrToInt | IntToPtr | BitCast | AddrSpaceCast + ) -> + true (* inline casts *) + | _ -> false (* do not inline if >= 2 uses *)) + | None -> true) + | None -> true diff --git a/test/passing/refs.default/locally_abtract_types.ml.ref b/test/passing/refs.default/locally_abtract_types.ml.ref new file mode 100644 index 0000000000..7a4b3616c4 --- /dev/null +++ b/test/passing/refs.default/locally_abtract_types.ml.ref @@ -0,0 +1,6 @@ +let f (type v) (x : v) = x +let f (type v) (x : v) : unit = () +let f : type s. s t -> s = function X x -> x | Y y -> y +let x = (fun (type a) x -> x) () +let x = (fun x (type a b c) x -> x) () +let f = function T x -> (fun (type a) (x : a t) -> x) x diff --git a/test/passing/refs.default/margin_80.ml.err b/test/passing/refs.default/margin_80.ml.err new file mode 100644 index 0000000000..ea16d07780 --- /dev/null +++ b/test/passing/refs.default/margin_80.ml.err @@ -0,0 +1,2 @@ +Warning: margin_80.ml:7 exceeds the margin +Warning: margin_80.ml:11 exceeds the margin diff --git a/test/passing/refs.default/margin_80.ml.ref b/test/passing/refs.default/margin_80.ml.ref new file mode 100644 index 0000000000..cf5791337d --- /dev/null +++ b/test/passing/refs.default/margin_80.ml.ref @@ -0,0 +1,23 @@ +type t = + ([ `foo + | `bar (** 58 chars.................................................. *) ] + [@js.enum]) + +let _ = + aa + (bbbbbbbbb cccccccccccc dddddddddddddddddddddddddddddddddddddddddddddddddddd) + +let _ = + aa + (bbbbbbbbb cccccccccccc dddddddddddddddddddddddddddddddddddddd [@dddddddddd]) + +let _ = + aa + (bbbbbbbbb cccccccccccc + ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd + [@dddddddddd]) + +let _ = + aa + (bbbbbbbbb cccccccccccc dddddddddddddddddddddddddddddddddddddd) + [@dddddddddd] diff --git a/test/passing/refs.default/match.ml.ref b/test/passing/refs.default/match.ml.ref new file mode 100644 index 0000000000..c57d1adc4d --- /dev/null +++ b/test/passing/refs.default/match.ml.ref @@ -0,0 +1,72 @@ +let _ = match a with A -> ( match b with B -> b | C -> c) | D -> D + +let _ = + match a with + | AAAAAAAAAA -> ( + match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> ccccccccccccccccc) + | DDDDDDDDDDDDDDd -> DDDDDDDDDDDDDDDDdD + +let _ = + match a with + | AAAAAAAAAA -> ( + let x = 3 in + match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> ccccccccccccccccc) + | DDDDDDDDDDDDDDd -> DDDDDDDDDDDDDDDDdD + +let _ = + match x with + | _ -> ( + match + something long enough to_break + _________________________________________________________________ + with + | AAAAAAAAAA -> ( + let x = 3 in + match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> ccccccccccccccccc) + | DDDDDDDDDDDDDDd -> DDDDDDDDDDDDDDDDdD) + +let x = + let g = + match x with + | `A -> ( + fun id -> function + | A -> + e; + e + | _ -> ()) + | `B -> ( + fun id -> function + | A -> + e; + e + | _ -> ()) + in + () + +let x = + let g = + match x with + | `A -> ( fun id -> function A -> () | B -> ()) + | `B -> ( fun id -> function A -> () | _ -> ()) + in + () + +let x = + let g = + match x with + | `A -> ( function A -> () | B -> ()) + | `B -> ( function A -> () | _ -> ()) + in + () + +let x = + let g = match x with `A -> fun (A | B) -> () | `B -> fun (A | _) -> () in + () + +let _ = match x with _ -> b >>= fun () -> c diff --git a/test/passing/refs.default/match2.ml.ref b/test/passing/refs.default/match2.ml.ref new file mode 100644 index 0000000000..ac367f1768 --- /dev/null +++ b/test/passing/refs.default/match2.ml.ref @@ -0,0 +1,90 @@ +let _ = match a with A -> (match b with B -> b | C -> c) | D -> D + +let _ = + match a with + | AAAAAAAAAA -> + (match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> ccccccccccccccccc) + | DDDDDDDDDDDDDDd -> DDDDDDDDDDDDDDDDdD + +let _ = + match a with + | AAAAAAAAAA -> + let x = 3 in + (match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> ccccccccccccccccc) + | DDDDDDDDDDDDDDd -> DDDDDDDDDDDDDDDDdD + +let _ = + match x with + | _ -> + (match + something long enough to_break + _________________________________________________________________ + with + | AAAAAAAAAA -> + let x = 3 in + (match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> ccccccccccccccccc) + | DDDDDDDDDDDDDDd -> DDDDDDDDDDDDDDDDdD) + +let x = + let g = + match x with + | `A -> fun id -> (function A -> () | B -> ()) + | `B -> fun id -> (function A -> () | _ -> ()) + in + () + +let x = + let g = + match x with + | `A -> (function A -> () | B -> ()) + | `B -> (function A -> () | _ -> ()) + in + () + +let x = + let g = match x with `A -> fun (A | B) -> () | `B -> fun (A | _) -> () in + () + +let _ = match x with _ -> b >>= fun () -> c + +[@@@ocamlformat "break-infix-before-func=false"] + +let foo = match foo with 1 -> bar >>= ( function _ -> () ) | other -> () + +let foo = + match foo with + | 1 -> bar >>= ( function a -> fooooo | b -> fooooo | _ -> () ) + | other -> () + +let foo = + match foo with + | 1 -> + bar >>= ( function + | a -> fooooo + | b -> fooooo + | c -> foooooooo foooooooooo fooooooooooooooooooo () + | _ -> () ) + | other -> () + +let _ = + match a with + | a -> + (match a with + | a -> + let+ a = b in + (match a with a -> a)) + +let _ = + match a with + | a -> + (match a with + | a -> + let+ a = b in + (match a with a -> a) + | b -> c) diff --git a/test/passing/tests/match_indent-never.ml.ref b/test/passing/refs.default/match_indent-never.ml.ref similarity index 100% rename from test/passing/tests/match_indent-never.ml.ref rename to test/passing/refs.default/match_indent-never.ml.ref diff --git a/test/passing/tests/match_indent.ml.ref b/test/passing/refs.default/match_indent.ml.ref similarity index 100% rename from test/passing/tests/match_indent.ml.ref rename to test/passing/refs.default/match_indent.ml.ref diff --git a/test/passing/refs.default/max_indent.ml.ref b/test/passing/refs.default/max_indent.ml.ref new file mode 100644 index 0000000000..d601ee23a6 --- /dev/null +++ b/test/passing/refs.default/max_indent.ml.ref @@ -0,0 +1,100 @@ +let () = + fooooo + |> List.iter (fun x -> + let x = x $ y in + fooooooooooo x) + +let () = + fooooo + |> List.iter + (fun some_really_really_really_long_name_that_doesn't_fit_on_the_line -> + let x = + some_really_really_really_long_name_that_doesn't_fit_on_the_line $ y + in + fooooooooooo x) + +let foooooooooo = + foooooooooooooooooooooo + |> Option.bind ~f:(function + | Pform.Expansion.Var (Values l) -> Some (static l) + | Macro (Ocaml_config, s) -> + Some (static (expand_ocaml_config (Lazy.force ocaml_config) var s)) + | Macro (Env, s) -> Option.map ~f:static (expand_env t var s)) + +let fooooooooooooo = + match lbls with + | (_, { lbl_all }, _) :: _ -> + let t = + Array.map + (fun lbl -> (mknoloc (Longident.Lident "?temp?"), lbl, omega)) + lbl_all + in + fooooooo + +let foooooooooo = + match fooooooooooooo with + | Pexp_construct + ({ txt = Lident "::"; _ }, Some { pexp_desc = Pexp_tuple [ _; e2 ]; _ }) + -> + if is_sugared_list e2 then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) + +let foooooooooooooooooooooooooo = + match foooooooooooooooooooooo with + | Pexp_apply + ( { + pexp_desc = + Pexp_ident + { txt = Lident (("~-" | "~-." | "~+" | "~+.") as op); loc }; + pexp_loc; + pexp_attributes = []; + _; + }, + [ (Nolabel, e1) ] ) -> + fooooooooooooooooooooooooooooooooooooo + +let fooooooooooooooooooooooooooooooooooo = + match foooooooooooooooooooooo with + | ( Ppat_constraint + ( ({ ppat_desc = Ppat_var _; _ } as p0), + { ptyp_desc = Ptyp_poly ([], t0); _ } ), + Pexp_constraint (e0, t1) ) + when Poly.(t0 = t1) -> + m.value_binding m + +let foooooooooooooooooooooooooooooooo = + match foooooooooooooooooooooooooooo with + | Tpat_variant (lab, Some omega, _) -> ( + fun q rem -> + match q.pat_desc with + | Tpat_variant (lab', Some arg, _) when lab = lab' -> (p, arg :: rem) + | Tpat_any -> (p, omega :: rem) + | _ -> raise NoMatch) + +let x = + some_fun________________________________ + some_arg______________________________ (fun param -> + do_something (); + do_something_else (); + return_this_value) + +let x = + some_fun________________________________ + some_arg______________________________ ~f:(fun param -> + do_something (); + do_something_else (); + return_this_value) + +let x = + some_value + |> some_fun (fun x -> + do_something (); + do_something_else (); + return_this_value) + +let x = + some_value + ^ some_fun (fun x -> + do_something (); + do_something_else (); + return_this_value) diff --git a/test/passing/refs.default/mod_type_subst.ml.ref b/test/passing/refs.default/mod_type_subst.ml.ref new file mode 100644 index 0000000000..82c45ba3d5 --- /dev/null +++ b/test/passing/refs.default/mod_type_subst.ml.ref @@ -0,0 +1,171 @@ +(** Basic *) +module type x = sig + type t = int +end + +module type t = sig + module type x + + module M : x +end + +module type t' = t with module type x = x +module type t'' = t with module type x := x + +module type t3 = + t + with + module type x = sig + type t + end + +module type t4 = + t + with + module type x := sig + type t + end + +(** nested *) + +module type ENDO = sig + module Inner : sig + module type T + + module F (_ : T) : T + end +end + +module type ENDO_2 = ENDO with module type Inner.T = ENDO +module type ENDO_2' = ENDO with module type Inner.T := ENDO + +module type S = sig + module M : sig + module type T + end + + module N : M.T +end + +module type R = S with module type M.T := sig end + +(** Adding equalities *) + +module type base = sig + type t = X of int | Y of float +end + +module type u = sig + module type t = sig + type t = X of int | Y of float + end + + module M : t +end + +module type s = u with module type t := base + +module type base = sig + type t = X of int | Y of float +end + +module type u = sig + type x + type y + + module type t = sig + type t = X of x | Y of y + end + + module M : t +end + +module type r = u with type x = int and type y = float and module type t = base +module type r = u with type x = int and type y = float and module type t := base + +(** First class module types require an identity *) + +module type fst = sig + module type t + + val x : (module t) +end + +module type ext +module type fst_ext = fst with module type t = ext +module type fst_ext = fst with module type t := ext +module type fst_erased = fst with module type t := sig end +module type fst_ok = fst with module type t = sig end + +module type S = sig + module M : sig + module type T + end + + val x : (module M.T) +end + +module type R = S with module type M.T := sig end + +module type S = sig + module M : sig + module type T + + val x : (module T) + end +end + +module type R = S with module type M.T := sig end + +(** local module type substitutions *) + +module type s = sig + module type u := sig + type a + type b + type c + end + + module type r = sig + type r + + include u + end + + module type s = sig + include u + + type a = A + end +end + +module type s = sig + module type u := sig + type a + type b + type c + end + + module type wrong = sig + type a + + include u + end +end + +module type fst = sig + module type t := sig end + + val x : (module t) +end + +module type hidden = sig + module type t := sig + type u + end + + include t + + val x : (module t) + val x : int +end diff --git a/test/passing/refs.default/module.ml.ref b/test/passing/refs.default/module.ml.ref new file mode 100644 index 0000000000..ec75119664 --- /dev/null +++ b/test/passing/refs.default/module.ml.ref @@ -0,0 +1,114 @@ +module AAAAAAAAAAAAAAAAAAA = + Soooooooooooooooooooooooome.Loooooooooooooooooooooooong.Mod + +let _ = + let module A = B in + let module AAAAAAAAAAAAAAAAAAA = + Soooooooooooooooooooooooome.Loooooooooooooooooooooooong.Mod + in + t + +let create (type a b) t i w p = + let module T = (val (t : (a, b) t)) in + T.create i w p + +module C = struct + module rec A : sig + type t + + module rec B : sig + type t + type z + end + + and A : B + end = + A + + and B : sig end = B +end + +module O : sig + type t +end +with type t := t = struct + let () = () +end + +module O : sig + type t +end +with type t := t + and type s := s = struct + let () = () +end + +include struct + (* a *) +end + +include A (struct + (* a *) +end) + +let x : (module S) = (module struct end) +let x = (module struct end : S) + +module rec A : (sig + type t +end +with type t = int) = struct + type t = int +end + +module A (_ : S) = struct end +module A : functor (_ : S) -> S' = functor (_ : S) -> struct end + +let helper ?x = + match x with Some (module X : X_typ) -> X.f | None -> X_add_one.f + +let helper ?x:((module X) = (module X_add_one : X_typ)) = X.f + +module GZ : functor (X : sig end) () (Z : sig end) -> sig end = + (val Mooooooooooooooooooo) + +module GZZZZZZZZZZZZZZ : functor (X : sig end) () (Z : sig end) -> sig end = _ +module M = struct end +module M = F () +module M = F (* xxx *) ( (* xxx *) ) (* xxx *) +module M = F (struct end) +module M = F (G) () +module M = F (G) ( (* xxx *) ) +module M = F (G) (struct end) + +module M = + F + (struct + val x : t + val y : t + end) + ( (* struct type z = K.y end *) ) + +let _ = + let module M = + (val (* aa *) m (* bb *) : (* cc *) M (* dd *) :> (* ee *) N (* ff *)) + in + let module M = + (val m + : M with type t = k and type p = k + :> N with type t = t and type k = t) + in + let module M = + (val (* aa *) m (* bb *) + : (* cc *) + M with type t = t (* dd *) + :> (* ee *) + N with type t = t (* ff *)) + in + () + +module M = + [%demo + module Foo = Bar + + type t] diff --git a/test/passing/refs.default/module_anonymous.ml.ref b/test/passing/refs.default/module_anonymous.ml.ref new file mode 100644 index 0000000000..04d8a138a1 --- /dev/null +++ b/test/passing/refs.default/module_anonymous.ml.ref @@ -0,0 +1,30 @@ +module _ = struct + let x = (13, 37) +end + +module rec A : sig + type t = B.t +end = + A + +and _ : sig + type t = A.t + + val x : int * int +end = struct + type t = B.t + + let x = (4, 2) +end + +and B : sig + type t +end = struct + type t + + let x = ("foo", "bar") +end + +module type S + +let f (module _ : S) = () diff --git a/test/passing/refs.default/module_attributes.ml.ref b/test/passing/refs.default/module_attributes.ml.ref new file mode 100644 index 0000000000..5657587b88 --- /dev/null +++ b/test/passing/refs.default/module_attributes.ml.ref @@ -0,0 +1,45 @@ +include (functor [@warning "item"] (M : S) -> N) [@@warning "structure"] + +include struct + type t +end [@warning "item"] [@@warning "structure"] + +include M [@warning "item"] [@@warning "structure"] +include (M : S) [@warning "item"] [@@warning "structure"] +include M (N) [@warning "item"] [@@warning "structure"] +include [%ext] [@warning "item"] [@@warning "structure"] +include (val M) [@warning "item"] [@@warning "structure"] + +include + (val Aaaaaaaaaaaaaaaa.Bbbbbbbbbbbbbbbb.Cccccccccccccccc.Dddddddddddddddd) + [@warning "item"] [@@warning "structure"] + +include ( + List : + module type of Foo with module A := A [@warning "-3"] with module B := B) + +include ( + List : + (module type of Foo + with module A := A + [@warning "-3"] [@warning "-3"] + with module B := B + [@warning "-3"])) + +include ( + List : + (module type of Pervasives + with module A := A + [@warning "-3"] [@warning "-3"] + with module B := B + [@warning "-3"] [@warning "-3"])) +[@warning "-3"] + +module My_module_name : sig end = struct end +(* some arbitrary comment *) +[@ocaml.warning "-60"] + +module type A = sig + module [@attr] A := A.B + module A := A.B [@@attr] +end diff --git a/test/passing/refs.default/module_item_spacing-preserve.ml.ref b/test/passing/refs.default/module_item_spacing-preserve.ml.ref new file mode 100644 index 0000000000..a9e62b8e09 --- /dev/null +++ b/test/passing/refs.default/module_item_spacing-preserve.ml.ref @@ -0,0 +1,129 @@ +let z = this one is pretty looooooooooooooooooooooooooooooooooong + +and z = so is this oooooooooooooooooooooooooooooooooooooooooooone +let f x = x + 1 +let z = this one is pretty looooooooooooooooooooooooooooooooooong +let z = so is this oooooooooooooooooooooooooooooooooooooooooooone +let g = () + +let f = function + | `a | `b | `c -> foo + | `xxxxxxxxxxxxxxxxxx -> + yyyyyyyyyyyyyyyyyyyyyyyy zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + +let x = 1 + +and y = 2 +let z = this one is pretty looooooooooooooooooooooooooooooooooong +let z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +module A = AA +module B = BB +open AA +module C = CC + +module M = + X + (Y) + (struct + let x = k + end) + +let x = 1 +let y = 2 +let x = 1 + +and y = 2 + +and c = { a : int; b : toto; c : char * char * char; d : [ `Foo | `Bar ] } + +and z = this one is pretty looooooooooooooooooooooooooooooooooong + +and z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +type k = A | B | K of int * char * string | E + +let x = 1 +let z = this one (is short) +let y = 2 +let w = + this one is toooooooooooooooooooooooooo + (looooooooooooooooooooooooog but is (originally a one - liner)) +let k = z + +module N = struct + let x = 1 + + let z = soooooooooo is this oooooooooooooooooooooooooooooooooooooooooooone + + let y = 2 + let z = soooooooooo iis this oooooooooooooooooooooooooooooooooooooooooooone + let y = 2 + module A = AA + include A + module B = BB + open B +end + +let x = x + +(** comment *) +and y = y + +let x = x + +(** floating comment *) + +and y = y + +let x = x + +and y = + something veeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeery + veeeeeeeeeeeeeeeeeeeeeeeeeeeery long + +let y = + something veeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeery + veeeeeeeeeeeeeeeeeeeeeeeeeeeery long + +and x = x + +let a = a + +and a = a + +and a = a + +and a = a + +and a = a + +and a = a + +let x = 1 + +(* floating *) + +let y = 2 + +let cmos_rtc_seconds = 0x00 +let cmos_rtc_seconds_alarm = 0x01 +let cmos_rtc_minutes = 0x02 + +let x = o + +let log_other = 0x000001 +let log_cpu = 0x000002 +let log_fpu = 0x000004 + +let cr0_pe = 1 lsl 0 +let cr0_mp = 1 lsl 1 +let cr0_em = 1 lsl 2 + +(* with double semicolons *) + +let foo = fooooooooooooooooooooooooooooo + +let foo = fooooooooooooooooooooooooooooo diff --git a/test/passing/refs.default/module_item_spacing-sparse.ml.ref b/test/passing/refs.default/module_item_spacing-sparse.ml.ref new file mode 100644 index 0000000000..ee250914ed --- /dev/null +++ b/test/passing/refs.default/module_item_spacing-sparse.ml.ref @@ -0,0 +1,150 @@ +let z = this one is pretty looooooooooooooooooooooooooooooooooong + +and z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +let f x = x + 1 + +let z = this one is pretty looooooooooooooooooooooooooooooooooong + +let z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +let g = () + +let f = function + | `a | `b | `c -> foo + | `xxxxxxxxxxxxxxxxxx -> + yyyyyyyyyyyyyyyyyyyyyyyy zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + +let x = 1 + +and y = 2 + +let z = this one is pretty looooooooooooooooooooooooooooooooooong + +let z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +module A = AA +module B = BB +open AA +module C = CC + +module M = + X + (Y) + (struct + let x = k + end) + +let x = 1 + +let y = 2 + +let x = 1 + +and y = 2 + +and c = { a : int; b : toto; c : char * char * char; d : [ `Foo | `Bar ] } + +and z = this one is pretty looooooooooooooooooooooooooooooooooong + +and z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +type k = A | B | K of int * char * string | E + +let x = 1 + +let z = this one (is short) + +let y = 2 + +let w = + this one is toooooooooooooooooooooooooo + (looooooooooooooooooooooooog but is (originally a one - liner)) + +let k = z + +module N = struct + let x = 1 + + let z = soooooooooo is this oooooooooooooooooooooooooooooooooooooooooooone + + let y = 2 + + let z = soooooooooo iis this oooooooooooooooooooooooooooooooooooooooooooone + + let y = 2 + + module A = AA + include A + module B = BB + open B +end + +let x = x + +(** comment *) +and y = y + +let x = x + +(** floating comment *) + +and y = y + +let x = x + +and y = + something veeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeery + veeeeeeeeeeeeeeeeeeeeeeeeeeeery long + +let y = + something veeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeery + veeeeeeeeeeeeeeeeeeeeeeeeeeeery long + +and x = x + +let a = a + +and a = a + +and a = a + +and a = a + +and a = a + +and a = a + +let x = 1 + +(* floating *) + +let y = 2 + +let cmos_rtc_seconds = 0x00 + +let cmos_rtc_seconds_alarm = 0x01 + +let cmos_rtc_minutes = 0x02 + +let x = o + +let log_other = 0x000001 + +let log_cpu = 0x000002 + +let log_fpu = 0x000004 + +let cr0_pe = 1 lsl 0 + +let cr0_mp = 1 lsl 1 + +let cr0_em = 1 lsl 2 + +(* with double semicolons *) + +let foo = fooooooooooooooooooooooooooooo + +let foo = fooooooooooooooooooooooooooooo diff --git a/test/passing/refs.default/module_item_spacing.ml.ref b/test/passing/refs.default/module_item_spacing.ml.ref new file mode 100644 index 0000000000..663e42e31f --- /dev/null +++ b/test/passing/refs.default/module_item_spacing.ml.ref @@ -0,0 +1,117 @@ +let z = this one is pretty looooooooooooooooooooooooooooooooooong +and z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +let f x = x + 1 +let z = this one is pretty looooooooooooooooooooooooooooooooooong +let z = so is this oooooooooooooooooooooooooooooooooooooooooooone +let g = () + +let f = function + | `a | `b | `c -> foo + | `xxxxxxxxxxxxxxxxxx -> + yyyyyyyyyyyyyyyyyyyyyyyy zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + +let x = 1 +and y = 2 + +let z = this one is pretty looooooooooooooooooooooooooooooooooong +let z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +module A = AA +module B = BB +open AA +module C = CC + +module M = + X + (Y) + (struct + let x = k + end) + +let x = 1 +let y = 2 + +let x = 1 +and y = 2 +and c = { a : int; b : toto; c : char * char * char; d : [ `Foo | `Bar ] } +and z = this one is pretty looooooooooooooooooooooooooooooooooong +and z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +type k = A | B | K of int * char * string | E + +let x = 1 +let z = this one (is short) +let y = 2 + +let w = + this one is toooooooooooooooooooooooooo + (looooooooooooooooooooooooog but is (originally a one - liner)) + +let k = z + +module N = struct + let x = 1 + let z = soooooooooo is this oooooooooooooooooooooooooooooooooooooooooooone + let y = 2 + let z = soooooooooo iis this oooooooooooooooooooooooooooooooooooooooooooone + let y = 2 + + module A = AA + include A + module B = BB + open B +end + +let x = x + +(** comment *) +and y = y + +let x = x + +(** floating comment *) + +and y = y + +let x = x + +and y = + something veeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeery + veeeeeeeeeeeeeeeeeeeeeeeeeeeery long + +let y = + something veeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeery + veeeeeeeeeeeeeeeeeeeeeeeeeeeery long + +and x = x + +let a = a +and a = a +and a = a +and a = a +and a = a +and a = a + +let x = 1 + +(* floating *) + +let y = 2 +let cmos_rtc_seconds = 0x00 +let cmos_rtc_seconds_alarm = 0x01 +let cmos_rtc_minutes = 0x02 +let x = o +let log_other = 0x000001 +let log_cpu = 0x000002 +let log_fpu = 0x000004 +let cr0_pe = 1 lsl 0 +let cr0_mp = 1 lsl 1 +let cr0_em = 1 lsl 2 + +(* with double semicolons *) + +let foo = fooooooooooooooooooooooooooooo +let foo = fooooooooooooooooooooooooooooo diff --git a/test/passing/refs.default/module_item_spacing.mli.ref b/test/passing/refs.default/module_item_spacing.mli.ref new file mode 100644 index 0000000000..8b2686dcc8 --- /dev/null +++ b/test/passing/refs.default/module_item_spacing.mli.ref @@ -0,0 +1,103 @@ +[@@@ocamlformat "module-item-spacing=compact"] + +val z : this one is pretty looooooooooooooooooooooooooooooooooong +val z : so is this oooooooooooooooooooooooooooooooooooooooooooone + +val f : k -> k -> k -> k -> k k -> k k -> k k +(** [f o o o o o o] is a great function. *) + +val z : this one is pretty looooooooooooooooooooooooooooooooooong +val z : so is this oooooooooooooooooooooooooooooooooooooooooooone +val g : unit + +val f : + aaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb -> + cccccccccccccccccccccccc -> + dddddddddddd + +val x : k +(** [x] is a great value. *) + +val z : k + +val y : k +(** [y] is a great value. *) + +val z : this one is pretty looooooooooooooooooooooooooooooooooong +val z : so is this oooooooooooooooooooooooooooooooooooooooooooone + +module A = AA +module B = BB +open AA +module C = CC + +module type M = sig + val a : z + val b : zz + val c : zzz +end + +val x : k +val y : k +val x : k +val y : k + +type c = { a : int; b : toto; c : char * char * char; d : [ `Foo | `Bar ] } + +val z : this one is pretty looooooooooooooooooooooooooooooooooong +val z : so is this oooooooooooooooooooooooooooooooooooooooooooone + +type k = A | B | K of int * char * string | E + +val x : k +val z : this one is short +val y : k + +val w : + this one is toooooooooooooooooooooooooo looooooooooooooooooooooooog but is + originally + a + one_liner + +val k : z + +module type N = sig + val x : k + val z : soooooooooo is this oooooooooooooooooooooooooooooooooooooooooooone + val y : k + val z : soooooooooo iis this oooooooooooooooooooooooooooooooooooooooooooone + val y : k + + module A = AA + include A + module B = BB + open B +end + +[@@@ocamlformat "module-item-spacing=preserve"] + +val cmos_rtc_seconds : foo +val cmos_rtc_seconds_alarm : foo +val cmos_rtc_minutes : foo + +val x : foo + +val log_other : foo +val log_cpu : foo +val log_fpu : foo + +val cr0_pe : foo +val cr0_mp : foo +val cr0_em : foo + +module C : sig + type config = t + + type 'a t + + type parsed_from = [ `File of Fpath.t * int | `Attribute ] +end + +module A := A +module A := A.B diff --git a/test/passing/refs.default/module_type.ml.err b/test/passing/refs.default/module_type.ml.err new file mode 100644 index 0000000000..ee3f924b86 --- /dev/null +++ b/test/passing/refs.default/module_type.ml.err @@ -0,0 +1,2 @@ +Warning: module_type.ml:35 exceeds the margin +Warning: module_type.ml:71 exceeds the margin diff --git a/test/passing/refs.default/module_type.ml.ref b/test/passing/refs.default/module_type.ml.ref new file mode 100644 index 0000000000..b00c8c2525 --- /dev/null +++ b/test/passing/refs.default/module_type.ml.ref @@ -0,0 +1,109 @@ +module type S = sig + val x : unit -> unit +end + +let get = failwith "TODO" + +let foo () = + let module X = (val get : S) in + X.x () + +module type S = sig end + +type t = (module S) +type 'a monoid_a = (module Monoid with type t = 'a) +type 'a monoid_a = (module Monoid with type F.t = 'a) + +let sumi (type a) ((module A) : a monoid_a) (n : a) = A.mappend n A.mempty + +module type BAR = sig + module rec A : (FOO with type t = < b : B.t >) + and B : FOO +end + +module type M = + module type of M + with module A := A + (*test*) + and module A = A + (*test*) + and module A = A + with module A = A + (*test*) + with module A = A + +module U : + S with type ttttttttt = int and type uuuuuuuu = int and type vvvvvvvvvvv = int = +struct end + +module U : + S with type ttttttttt = int and type uuuuuuu = int with type vvvvvvvvv = int = +struct end + +module U : + S + with type Command.t = + [ `Halt + | `Unknown + | `Error of string + | `Config of (string * string) list + | `Format of string ] + and type Command.t = + [ `Halt + | `Unknown + | `Error of string + | `Config of (string * string) list + | `Format of string ] = struct end + +module U = (val S : S with type t = int and type u = int) +module U = (val S : S with type t = int and type u = int) + +module type S = sig + (* floating *) + + exception E +end + +module type S' = functor + (A : A) + (B : sig + type t + end) + (Cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc : sig + type t + end) + -> S with type t = B.t + +module M : sig + include (* foo *) module type of K + + include module type of + Fooooooooooooooooooooooooooo (Foooooooooo.Foo) (Fooooooooooooo) + (Fooooooooooooo) + + include (* fooooooooo *) module type of + Fooooooooooooooooooooooooooo (Foooooooooo.Foo) (Fooooooooooooo) + (Fooooooooooooo) +end = struct end + +let foo (type foooo fooo_ooooo) + (module Fooo : Fooooo_foooooooooo.Foooo_intf.Bar + with type foooo = foooo + and type Fooo_fooooooooo_fooooo.t = + ( xxxxx, + wwwwwwwwww, + xxxxxxxxxxxxxxxxxxxx, + xxxxxxxxxxxxxxxxx, + xxxxxxxxxxxxxxxxxxxxxx, + yyyyyyyyyyyyyyyyyyyyyy ) + Fooooo_ooooooo_oooooo.Foooo_fooooooooo_fooooo.t) + (Fooo.Fooo.T (foo, bar)) xxxx = + () + +module N : S with module type T = (U with module M = M) = struct end + +module type Grammar = functor + (Nonterm : Nonterminal) + (* Set of nonterminals *) + (Attr : Attribute) + -> sig end diff --git a/test/passing/refs.default/module_type.mli.err b/test/passing/refs.default/module_type.mli.err new file mode 100644 index 0000000000..2c5587aad9 --- /dev/null +++ b/test/passing/refs.default/module_type.mli.err @@ -0,0 +1 @@ +Warning: module_type.mli:3 exceeds the margin diff --git a/test/passing/tests/module_type.mli.ref b/test/passing/refs.default/module_type.mli.ref similarity index 100% rename from test/passing/tests/module_type.mli.ref rename to test/passing/refs.default/module_type.mli.ref diff --git a/test/passing/refs.default/monadic_binding.ml.ref b/test/passing/refs.default/monadic_binding.ml.ref new file mode 100644 index 0000000000..b1afbff4d3 --- /dev/null +++ b/test/passing/refs.default/monadic_binding.ml.ref @@ -0,0 +1,30 @@ +let ( let* ) t f = fooooooo +let ( and* ) t1 t2 = foooooo + +let map f t = + let* a = t in + pure (f a) + +let ( and+ ) t1 t2 = ( and* ) t1 t2 +let ( and+ ) t1 t2 = ( and* ) t1 t2 x + +let ( and+ ) t1 t2 = + ( and* ) t1 t2 x foooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo + foooooooooooooooooo + +let _ = ( let* ) x (fun y -> z) +let _ = ( let* ) x (function y -> z) +let _ = f (( let* ) x (fun y -> z)) +let _ = f (( let* ) x (function y -> z)) +let _ = ( let+ ) [@attr] +let _ = f (( let+ ) [@attr]);; + +( let+ ) [@attr] + +let _ = + let* (args, _) : bar = () in + let* (arg : bar) = () in + let* (_ : foo) = () in + let* (_ as t) = xxx in + let+ (Ok x) = xxx in + () diff --git a/test/passing/refs.default/multi_index_op.ml.ref b/test/passing/refs.default/multi_index_op.ml.ref new file mode 100644 index 0000000000..c337f224b0 --- /dev/null +++ b/test/passing/refs.default/multi_index_op.ml.ref @@ -0,0 +1,12 @@ +let ( .%{;..} ) = Genarray.get +let ( .%{;..}<- ) = Genarray.set + +let () = + let x = Genarray.create Float64 c_layout [| 3; 4; 5 |] in + x.%{0; 0; 0} <- 3.; + Printf.printf "%f\n" x.%{0; 0; 0} + +(** With path *) + +let _ = a.A.B.*(b; c) +let _ = a.A.B.*(b; c) <- d diff --git a/test/passing/refs.default/named_existentials.ml.ref b/test/passing/refs.default/named_existentials.ml.ref new file mode 100644 index 0000000000..4335210a19 --- /dev/null +++ b/test/passing/refs.default/named_existentials.ml.ref @@ -0,0 +1,22 @@ +let ok1 = function Dyn (type a) ((w, x) : a ty * a) -> ignore (x : a) +let ok2 = function Dyn (type a) ((w, x) : _ * a) -> ignore (x : a) + +type u = C : 'a * ('a -> 'b list) -> u + +let f = function C (type a b) ((x, f) : _ * (a -> b list)) -> ignore (x : a) + +(* with GADT unification *) +type _ expr = + | Int : int -> int expr + | Add : (int -> int -> int) expr + | App : ('a -> 'b) expr * 'a expr -> 'b expr + +let rec eval : type t. t expr -> t = function + | Int n -> n + | Add -> ( + ) + | App (type a) ((f, x) : _ * a expr) -> eval f (eval x : a) + +(* Also allow annotations on multiary constructors *) +type ('a, 'b) pair = Pair of 'a * 'b + +let f = function Pair ((x, y) : int * _) -> x + y diff --git a/test/passing/refs.default/need_format.ml.err b/test/passing/refs.default/need_format.ml.err new file mode 100644 index 0000000000..5f78142e1f --- /dev/null +++ b/test/passing/refs.default/need_format.ml.err @@ -0,0 +1 @@ +ocamlformat: "need_format.ml" was not already formatted. ([max-iters = 1]) diff --git a/test/passing/refs.default/new.ml.ref b/test/passing/refs.default/new.ml.ref new file mode 100644 index 0000000000..3a1e49ea84 --- /dev/null +++ b/test/passing/refs.default/new.ml.ref @@ -0,0 +1,8 @@ +let x = new Objects.one ~hello:true () +let _ = sprintf "Date: %s" (Js.to_string (new%js Js.date_now)##toString) +let _ = f (new test) a b +let _ = f (new test x) a b +let _ = f (new test (new test a b) c) a b +let _ = f (new%js test) a b +let _ = f (new%js test x) a b +let _ = f (new%js test (new%js test a b) c) a b diff --git a/test/passing/refs.default/object.ml.ref b/test/passing/refs.default/object.ml.ref new file mode 100644 index 0000000000..fd597d043f --- /dev/null +++ b/test/passing/refs.default/object.ml.ref @@ -0,0 +1,276 @@ +let _ = + object + (* some comment *) + inherit M.t as p [@@attr] + + (* some comment *) + method! x = 2 [@@attr] + method x = (1 [@attr]) + method virtual x : t + method virtual private x : t + method! private x = 3 + method! private x : t = 4 + method! private x : type a b c. r = 5 + method! private x : type a. r = 6 + val virtual x : t + val virtual mutable x : t + val virtual mutable x : t + val! mutable x = 7 + val! mutable x : t = 8 + constraint t = 'a t + [%%ext salut, "hello"] + [@@@attr] + + initializer + f x; + 9 + + initializer + let x = y in + z + + method x = + let f = {<a; b = e>} in + x <- expr + + method x : type a b c. (a, b) t -> c = + let f = {<a; b = e>} in + x <- expr + + method x : (a, b) t -> c = + let f = + {<a + ; b = something very + loooooooooooooooooooooooooooooooooooooooooooooooong>} + in + x <- + something very + looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong + end + +let _ = f a#b (a#c x y) +let _ = f a##.b (a##c x y) + +type t = (int, int) #q + +let _ = object%js end +let _ = object%js (super) end +let _ = object%js (super : 'a) end +let _ = f (object end) +let _ = f (object%js end) + +class t ~a = + object + inherit f a + method x a b = a + b + end + +class type mapper = [%test] + +module type A = sig + class mapper : int -> x:int -> ?y:int -> object + method xxxxxxxxxxxxxxxxxxxxxxxxxxx : int + end + + class tttttttttttt : + aaaaaaaaaaaaaaaaaa:int -> + bbbbbbbbbbbbbbbbbbbbb:float -> + cccccccccccccccccccc + + class c : object + inherit ['a a] d + constraint 'a = int + [%%ext something] + [@@@attr something] + val (*x*) virtual (*y*) mutable (*z*) a : int + val (*x*) mutable (*y*) virtual (*z*) a : int + method (*x*) virtual (*y*) private (*z*) b : int -> int -> int + method (*x*) private (*y*) virtual (*z*) b : int -> int -> int + end +end + +class type mapper = + let open Modl1 in +object + method expression : Javascript.expression -> Javascript.expression + + method expression_o : + Javascript.expression option -> Javascript.expression option + + method switch_case : + Javascript.expression -> + Javascript.expression -> + a -> + b -> + ccccccccccc -> + d -> + e +end + +class tttttttttttttttttttttttttt ~aaaaaaaaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbb = + object + inherit f a + method x a b = a + b + end + +class tttttttttttttttttttttttttt x y = + let open Mod in + let x = 2 in + let f x = + object + inherit f a + method x a b = a + b + end + in + f 0 + +class tttttttttttttttttttttttttt x y = + let open Mod in + let x = 2 in + (fun x -> + object + inherit f a + method x a b = a + b + end) + 0 + +class c = + object + method a : type a b c. d -> e -> f = g + (** about a *) + + (** floatting *) + + method a : 'a. d -> e -> f = g + (** about a *) + end + +class a = object end +(** about a *) + +(** floatting *) + +and b = object end +(** about b *) + +class type x = object + (** floatting1 *) + + (** floatting2 *) + + method x : int + + (** floatting3 *) +end + +class x = + object + + (** floatting1 *) + + (** floatting2 *) + + method x = 2 + + (** floatting3 *) + end + +let _ = f ##= (fun x -> x) + +let o = + object + method int_bin_op : + int t * [ `Plus | `Minus | `Mult | `Div | `Mod ] * int t -> int t = + fun (a, op, b) -> Int_bin_op (self#expression a, op, self#expression b) + + method int_bin_comparison aaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbb + ccccccccccccccccccccc ddddddddddddddddddddddddd : + int t * [ `Eq | `Ne | `Gt | `Ge | `Lt | `Le ] * int ttttttttt -> + bool tttttttttttttttt rrrrrrrrrrrrrrrrrrrrr rrrrrrrrrrrrrrrrrrrrr + rrrrrrrrrrrrrrrrrrrrrrr = + fun (a, op, b) -> + Int_bin_comparison (self#expression a, op, self#expression b) + end + +class f = fun [@inline] (b [@inline]) -> object end +class f = [%test] [@test] +class f a (b [@inline]) = object end + +class f = + object (self) + inherit [a] c (f 1) (fun x -> x) (match x with x -> x) as p + end + +class f ((i, o) as io) = + object (self) + inherit [a] c (f 1) (fun x -> x) (match x with x -> x) as p + end + +class type ['a] tsv = object + inherit [ < sep : [ `tab ] ; comment : [ `sharp ] ; .. > as 'a] tabular +end +;; + +{<(* Debug.print ("free var: "^string_of_int x); *) + free_vars = IntSet.add x free_vars>} +;; + +{<(* Debug.print ("free var: "^string_of_int x); *) free_vars>};; + +{<(* Debug.print ("free var: "^string_of_int x); *) + very_loooooooooooong_identifier>} +;; + +{<(* Debug.print ("free var: "^string_of_int x); *) + x = (Some k : t) + ; (* Debug.print ("free var: "^string_of_int x); *) + y = yet another value>} +;; + +{<(* check: e is effectively the index associated with e, and check that + already in *) + x = y>} + +class type a = b[@attr] +class type a = object end[@attr] + +(* Syntax error: class type a = b -> c[@attr] *) +(* Cannot attach attribute: class a : b -> c = d *) + +class type a = [%ext][@attr] + +class type a = + let open[@attr] A in + b + +class a = + let open[@attr] A in + b + +class t (lazy _) = object end + +class virtual c = + let (mc_exit : _) = () in + object end + +(* Fitting *) + +class a = object end +class a x = object end +class a x = object end +class a x = object (self) end + +let x = + fun [@foo] x -> + fun [@foo] y -> + object + method x = y + end + +class x = + fun [@foo] x -> + fun [@foo] y -> + object + method x = y + end diff --git a/test/passing/refs.default/object2.ml.ref b/test/passing/refs.default/object2.ml.ref new file mode 100644 index 0000000000..994dd5dcba --- /dev/null +++ b/test/passing/refs.default/object2.ml.ref @@ -0,0 +1,27 @@ +let x = + object + inherit foo + method bar = _ + end + +class foo = + object + method x = 2 + inherit bar + end + +class foo = + object (this) + inherit bar + end + +class virtual map = + object + method visit_expr_node : + 'env 'info_0 'info_1. + ('env -> 'info_0 -> 'info_1) -> + 'env -> + 'info_0 expr_node -> + 'info_1 expr_node = + assert false + end diff --git a/test/passing/refs.default/object_expr-414.ml.ref b/test/passing/refs.default/object_expr-414.ml.ref new file mode 100644 index 0000000000..684ac2cfe4 --- /dev/null +++ b/test/passing/refs.default/object_expr-414.ml.ref @@ -0,0 +1,23 @@ +object + method one = 1 +end + #one +;; + +Some + object + method one = 1 + end +;; + +ignore + object + method one = 1 + end + +let () = + f + (object + method m x = x + end + [@xxx]) diff --git a/test/passing/refs.default/object_expr.ml.ref b/test/passing/refs.default/object_expr.ml.ref new file mode 100644 index 0000000000..c16955cb1c --- /dev/null +++ b/test/passing/refs.default/object_expr.ml.ref @@ -0,0 +1,23 @@ +(object + method one = 1 +end) + #one +;; + +Some + (object + method one = 1 + end) +;; + +ignore + (object + method one = 1 + end) + +let () = + f + (object + method m x = x + end + [@xxx]) diff --git a/test/passing/refs.default/object_type.ml.ref b/test/passing/refs.default/object_type.ml.ref new file mode 100644 index 0000000000..b6ef7cba7f --- /dev/null +++ b/test/passing/refs.default/object_type.ml.ref @@ -0,0 +1,64 @@ +type t = + < hello : string (** some doc *) + ; world : int + ; more : int * float + ; make : int + ; it : string + ; long : float [@default 42.] > +[@@deriving make] + +type 'a u = < hello : string (** more doc *) ; world : int ; .. > as 'a +type 'a v = < .. > as 'a +type 'a w = (< .. > as 'a) -> 'a +type z = < > t + +let x : unit -> < bouh : string ; .. > = fun () -> assert false +let lookup_obj : < .. > -> (< .. > as 'a) list -> 'a = fun _ -> assert false +let _ = [%ext: < a ; b > ] +let _ = x [@att: < a ; b > ] + +type t = [ `A of < a ; b > ] +type t = private [> ] +type t = < a : < > > +type t = { a : < >; b : int } +type t = { b : int; a : < > } + +class type c = object + inherit [ < a : 'a ; b : 'b > ] a + inherit [a, b, c] a +end + +class c = + object + inherit [ < a : 'a ; b : 'b > ] a + inherit [a, b, c] a + end + +type 'a u = [< `A | `B of < > > `B ] as 'a + +(** about a *) +class type a = object + method a : int + (** about a *) + + (** floatting *) + + method b : int + (** about b *) +end + +(** floatting *) + +and b = object end +(** about b *) + +class type i = object + (* test *) + inherit oo +end + +class i = + object + (* test *) + inherit oo + end diff --git a/test/passing/refs.default/obuild.ml.ref b/test/passing/refs.default/obuild.ml.ref new file mode 100644 index 0000000000..e50862e6f1 --- /dev/null +++ b/test/passing/refs.default/obuild.ml.ref @@ -0,0 +1,9 @@ +type predicate = Pred_Byte | Pred_Native | Pred_Toploop + +let _ = + { + pkg with + package_version = projFile.version; + package_description = _; + package_requires = []; + } diff --git a/test/passing/refs.default/ocp_indent_compat-break_colon_after.ml.ref b/test/passing/refs.default/ocp_indent_compat-break_colon_after.ml.ref new file mode 100644 index 0000000000..99d176299e --- /dev/null +++ b/test/passing/refs.default/ocp_indent_compat-break_colon_after.ml.ref @@ -0,0 +1,94 @@ +(* Bad: unboxing the function type *) +external i : (int -> float[@unboxed]) = "i" "i_nat" + +module type M = sig + val action : action + (** Formatting action: input type and source, and output destination. *) + + val doc_atrs : + (string Location.loc * payload) list -> + (string Location.loc * bool) list option + * (string Location.loc * payload) list + + val transl_modtype_longident + (* from Typemod *) : + (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val transl_modtype_longident + (* foooooooooo fooooooooooooo foooooooooooo foooooooooooooo foooooooooooooo + foooooooooooo + *) : + (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val imported_sets_of_closures_table : + Simple_value_approx.function_declarations option Set_of_closures_id.Tbl.t + + type 'a option_decl = + names:string list -> + doc:string -> + section:[ `Formatting | `Operational ] -> + ?allow_inline:bool -> + (config -> 'a -> config) -> + (config -> 'a) -> + 'a t + + val select : + (* The fsevents context *) + env -> + (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list -> + (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list -> + (* Timeout...like Unix.select *) + timeout:float -> + (* The callback for file system events *) + (event list -> unit) -> + unit + + val f : + x:t + (** an extremely long comment about [x] that does not fit on the same + line with [x] *) -> + unit + + val f : + fooooooooooooooooo: + (fooooooooooooooo -> + fooooooooooooooooooo -> + foooooooooooooo -> + foooooooooooooo * fooooooooooooooooo -> + foooooooooooooooo) + (** an extremely long comment about [x] that does not fit on the same + line with [x] *) -> + unit +end + +let ssmap : + (module MapT + with type key = string + and type data = string + and type map = SSMap.map) + = + () + +let ssmap : + (module MapT + with type key = string + and type data = string + and type map = SSMap.map) -> + unit + = + () + +let long_function_name : type a. + a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit + = + fun () -> () + +let add_edge target dep = + if target <> dep then ( + Hashtbl.replace edges dep + (target :: (try Hashtbl.find edges dep with Not_found -> [])); + Hashtbl.replace edge_count target + (1 + try Hashtbl.find edge_count target with Not_found -> 0); + if not (Hashtbl.mem edge_count dep) then Hashtbl.add edge_count dep 0) diff --git a/test/passing/refs.default/ocp_indent_compat.ml.ref b/test/passing/refs.default/ocp_indent_compat.ml.ref new file mode 100644 index 0000000000..c5cf31bd68 --- /dev/null +++ b/test/passing/refs.default/ocp_indent_compat.ml.ref @@ -0,0 +1,94 @@ +(* Bad: unboxing the function type *) +external i : (int -> float[@unboxed]) = "i" "i_nat" + +module type M = sig + val action : action + (** Formatting action: input type and source, and output destination. *) + + val doc_atrs + : (string Location.loc * payload) list -> + (string Location.loc * bool) list option + * (string Location.loc * payload) list + + val transl_modtype_longident + (* from Typemod *) + : (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val transl_modtype_longident + (* foooooooooo fooooooooooooo foooooooooooo foooooooooooooo foooooooooooooo + foooooooooooo + *) + : (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val imported_sets_of_closures_table + : Simple_value_approx.function_declarations option Set_of_closures_id.Tbl.t + + type 'a option_decl = + names:string list -> + doc:string -> + section:[ `Formatting | `Operational ] -> + ?allow_inline:bool -> + (config -> 'a -> config) -> + (config -> 'a) -> + 'a t + + val select + : (* The fsevents context *) + env -> + (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list -> + (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list -> + (* Timeout...like Unix.select *) + timeout:float -> + (* The callback for file system events *) + (event list -> unit) -> + unit + + val f + : x:t + (** an extremely long comment about [x] that does not fit on the same + line with [x] *) -> + unit + + val f + : fooooooooooooooooo: + (fooooooooooooooo -> + fooooooooooooooooooo -> + foooooooooooooo -> + foooooooooooooo * fooooooooooooooooo -> + foooooooooooooooo) + (** an extremely long comment about [x] that does not fit on the same + line with [x] *) -> + unit +end + +let ssmap + : (module MapT + with type key = string + and type data = string + and type map = SSMap.map) + = + () + +let ssmap + : (module MapT + with type key = string + and type data = string + and type map = SSMap.map) -> + unit + = + () + +let long_function_name + : type a. a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit + = + fun () -> () + +let add_edge target dep = + if target <> dep then ( + Hashtbl.replace edges dep + (target :: (try Hashtbl.find edges dep with Not_found -> [])); + Hashtbl.replace edge_count target + (1 + try Hashtbl.find edge_count target with Not_found -> 0); + if not (Hashtbl.mem edge_count dep) then Hashtbl.add edge_count dep 0) diff --git a/test/passing/refs.default/ocp_indent_options.ml.ref b/test/passing/refs.default/ocp_indent_options.ml.ref new file mode 100644 index 0000000000..e949d7c6c9 --- /dev/null +++ b/test/passing/refs.default/ocp_indent_options.ml.ref @@ -0,0 +1,8 @@ +let _ = + let f x y = + match x with + | None -> false + | Some loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( + match y with Some _ -> true | None -> false) + in + () diff --git a/test/passing/refs.default/open-closing-on-separate-line.ml.ref b/test/passing/refs.default/open-closing-on-separate-line.ml.ref new file mode 100644 index 0000000000..bfd3a0f79c --- /dev/null +++ b/test/passing/refs.default/open-closing-on-separate-line.ml.ref @@ -0,0 +1,353 @@ +let _ = Some_module.Submodule.(a + b) +let _ = A.(a, b) + +let _ = + let open Some_module.Submodule in + AAAAAAAAAAAAAAAAAAAAAAAAAAAA.(a + b) + +let _ = + let open Some_module.Submodule in + let module A = MMMMMM in + a + b + c + +let _ = + let open Some_module.Submodule in + let exception A of int in + a + b + +let _ = + let open Some_module.Submodule in + [%except {| result |}] + +let _ = + let open Some_module.Submodule in + [%except {| loooooooooooooooooooooooooong result |}] + +let _ = + let open Some_module.Submodule in + let x = a + b in + let y = f x in + y + +let () = + ( (let open Term in + term_result + (const Phases.phase1 $ arch $ hub_id $ build_dir $ logs_dir $ setup_logs) + ), + Term.info "phase1" ~doc ~sdocs:Manpage.s_common_options ~exits ~man + ) + +let () = + (let open Arg in + let doc = "Output all." in + value & flag & info [ "all" ] ~doc + ) + $ + let open Arg in + let doc = "Commit to git." in + value & flag & info [ "commit"; "c" ] ~doc + +let () = + Arg.( + let doc = "Output all." in + value & flag & info [ "all" ] ~doc + ) + $ Arg.( + let doc = "Commit to git." in + value & flag & info [ "commit"; "c" ] ~doc + ) + +let () = X.(f y i) +let () = X.(i) + +let () = + let open X in + f y i + +let () = + let open X in + i + +let () = + let open! K in + x y z + +let x = + let Cstruct.{ buffer = bigstring; off = offset; len = length } = + Cstruct.{ toto = foooo } + in + fooooooooo + +open A +open A.B +open A (B) + +open struct + type t +end + +open ( + struct + type t + end : + T +) + +open ( + struct + type t + end : + sig + type t + end +) + +open (val x) +open (val x) +open [%extension] +open functor (A : T) -> T' + +module type T = sig + open A + open A.B + open A(B) +end + +let x = + let open struct + type t' = t + end in + foo + +let x = + let open struct + open struct + type t = T + end + + let y = T + end in + foo + +let x = + let open struct + open struct + let counter = ref 0 + end + end in + foo + +let x = + let open struct + let open struct + let counter = ref 0 + end in + foo + end in + foo + +let x = + let open struct + module A = struct + open struct + let x = 1 + end + + let y = x + + open struct + let x = 1 + end + + let z = y + x + end + end in + foo + +class type a = + (* A'' *) + let open (* A' *) A (* A *) in + (* B *) + b + +class a = + (* A'' *) + let open (* A' *) A (* A *) in + (* B *) + b + +let _ = + (* a *) + let (* b *) open (* c *) struct + type t + end + (* d *) in + (* e *) + (* f *) + let (* g *) open (* h *) A (* i *) (B) (* j *) in + (* k *) + () + +(* l *) +open (* m *) struct + type t +end +(* n *) + +open A +open B + +open struct + type t +end + +open + functor + (A : S) + -> + struct + type t + end + +open + functor + (_ : S) + -> + struct + type t + end + +open A (B) +open (A : S) +open (val x) +open [%ext] + +let _ = + let open A in + let open B in + let open struct + type t + end in + let open + functor + (A : S) + -> + struct + type t + end in + let open + functor + (_ : S) + -> + struct + type t + end in + let open A (B) in + let open (A : S) in + let open (val x) in + let open [%ext] in + () + +open [@attr] A +open [@attr] B + +open [@attr] struct + type t +end + +open + [@attr] + functor + (A : S) + -> + struct + type t + end + +open + [@attr] + functor + (_ : S) + -> + struct + type t + end + +open [@attr] A (B) +open [@attr] (A : S) +open [@attr] (val x) +open [@attr] [%ext] + +let g = + M.f + ((let open M in + x + ) [@attr] + ) + +let _ = M.({ f } [@warning "foo"]) +let _ = M.((* A *) { f }) +let _ = M.({ f } (* B *)) +let _ = M.((* A *) { f } (* B *)) +let _ = M.((* A *) { f } (* B *) [@warning "foo"] (* C *)) +let _ = M.([| f |] [@warning "foo"]) +let _ = M.((* A *) [| f |]) +let _ = M.([| f |] (* B *)) +let _ = M.((* A *) [| f |] (* B *)) +let _ = M.((* A *) [| f |] (* B *) [@warning "foo"] (* C *)) +let _ = M.([ f ] [@warning "foo"]) +let _ = M.((* A *) [ f ]) +let _ = M.([ f ] (* B *)) +let _ = M.([ f ] (* B *)) (* after *) +let _ = M.((* A *) [ f ] (* B *)) +let _ = M.((* A *) [ f ] (* B *) [@warning "foo"] (* C *)) +let _ = M.((f, f) [@warning "foo"]) +let _ = M.((* A *) (f, f)) +let _ = M.((f, f) (* B *)) +let _ = M.((* A *) (f, f) (* B *)) +let _ = M.((* A *) ((f, f) (* B *) [@warning "foo"] (* C *))) + +let _ = + let _ = + Fooooooo. + [ + (swap_1_c, { minimum_transfert_amount = 0. }); + (swap_2_c, { minimum_transfert_amount = 0. }); + (swap_3_c, { minimum_transfert_amount = 0. }); + ] + in + () + +let _ = + match Uri.scheme uri with + | Some _ -> ( + (* we have an absoluteURI *) + Uri.( + match path uri with "" -> with_path uri "/" | _ -> uri + ) + ) + +(* Ptyp_open *) + +let _ : M.(foo * M.(bar)) = () +let _ : M.(foo) * M.(bar) = () +let _ : M.([ `Foo of foo ]) = () +let _ : M.N.(foo) = () + +let _ : + M.( + foooooooooooooooooooooooooooooooooooooooo + * foooooooooooooooooooooooooooooooooooooooo) = + () + +let _ : + M.( + [ `Foo of + foooooooooooooooooooooooooooooooooooooooo + * foooooooooooooooooooooooooooooooooooooooo ]) = + () + +let _ : M.((foo[@attr])) = () +let _ : (M.(foo)[@attr]) = () +let _ : M.((foo[@attr] [@attr])) = () +let _ : (M.((foo[@attr]))[@attr]) = () diff --git a/test/passing/refs.default/open.ml.err b/test/passing/refs.default/open.ml.err new file mode 100644 index 0000000000..db5427adce --- /dev/null +++ b/test/passing/refs.default/open.ml.err @@ -0,0 +1 @@ +Warning: open.ml:34 exceeds the margin diff --git a/test/passing/refs.default/open.ml.ref b/test/passing/refs.default/open.ml.ref new file mode 100644 index 0000000000..6e752bccae --- /dev/null +++ b/test/passing/refs.default/open.ml.ref @@ -0,0 +1,342 @@ +let _ = Some_module.Submodule.(a + b) +let _ = A.(a, b) + +let _ = + let open Some_module.Submodule in + AAAAAAAAAAAAAAAAAAAAAAAAAAAA.(a + b) + +let _ = + let open Some_module.Submodule in + let module A = MMMMMM in + a + b + c + +let _ = + let open Some_module.Submodule in + let exception A of int in + a + b + +let _ = + let open Some_module.Submodule in + [%except {| result |}] + +let _ = + let open Some_module.Submodule in + [%except {| loooooooooooooooooooooooooong result |}] + +let _ = + let open Some_module.Submodule in + let x = a + b in + let y = f x in + y + +let () = + ( (let open Term in + term_result + (const Phases.phase1 $ arch $ hub_id $ build_dir $ logs_dir $ setup_logs)), + Term.info "phase1" ~doc ~sdocs:Manpage.s_common_options ~exits ~man ) + +let () = + (let open Arg in + let doc = "Output all." in + value & flag & info [ "all" ] ~doc) + $ + let open Arg in + let doc = "Commit to git." in + value & flag & info [ "commit"; "c" ] ~doc + +let () = + Arg.( + let doc = "Output all." in + value & flag & info [ "all" ] ~doc) + $ Arg.( + let doc = "Commit to git." in + value & flag & info [ "commit"; "c" ] ~doc) + +let () = X.(f y i) +let () = X.(i) + +let () = + let open X in + f y i + +let () = + let open X in + i + +let () = + let open! K in + x y z + +let x = + let Cstruct.{ buffer = bigstring; off = offset; len = length } = + Cstruct.{ toto = foooo } + in + fooooooooo + +open A +open A.B +open A (B) + +open struct + type t +end + +open ( + struct + type t + end : + T) + +open ( + struct + type t + end : + sig + type t + end) + +open (val x) +open (val x) +open [%extension] +open functor (A : T) -> T' + +module type T = sig + open A + open A.B + open A(B) +end + +let x = + let open struct + type t' = t + end in + foo + +let x = + let open struct + open struct + type t = T + end + + let y = T + end in + foo + +let x = + let open struct + open struct + let counter = ref 0 + end + end in + foo + +let x = + let open struct + let open struct + let counter = ref 0 + end in + foo + end in + foo + +let x = + let open struct + module A = struct + open struct + let x = 1 + end + + let y = x + + open struct + let x = 1 + end + + let z = y + x + end + end in + foo + +class type a = + (* A'' *) + let open (* A' *) A (* A *) in + (* B *) + b + +class a = + (* A'' *) + let open (* A' *) A (* A *) in + (* B *) + b + +let _ = + (* a *) + let (* b *) open (* c *) struct + type t + end + (* d *) in + (* e *) + (* f *) + let (* g *) open (* h *) A (* i *) (B) (* j *) in + (* k *) + () + +(* l *) +open (* m *) struct + type t +end +(* n *) + +open A +open B + +open struct + type t +end + +open + functor + (A : S) + -> + struct + type t + end + +open + functor + (_ : S) + -> + struct + type t + end + +open A (B) +open (A : S) +open (val x) +open [%ext] + +let _ = + let open A in + let open B in + let open struct + type t + end in + let open + functor + (A : S) + -> + struct + type t + end in + let open + functor + (_ : S) + -> + struct + type t + end in + let open A (B) in + let open (A : S) in + let open (val x) in + let open [%ext] in + () + +open [@attr] A +open [@attr] B + +open [@attr] struct + type t +end + +open + [@attr] + functor + (A : S) + -> + struct + type t + end + +open + [@attr] + functor + (_ : S) + -> + struct + type t + end + +open [@attr] A (B) +open [@attr] (A : S) +open [@attr] (val x) +open [@attr] [%ext] + +let g = + M.f + ((let open M in + x) [@attr]) + +let _ = M.({ f } [@warning "foo"]) +let _ = M.((* A *) { f }) +let _ = M.({ f } (* B *)) +let _ = M.((* A *) { f } (* B *)) +let _ = M.((* A *) { f } (* B *) [@warning "foo"] (* C *)) +let _ = M.([| f |] [@warning "foo"]) +let _ = M.((* A *) [| f |]) +let _ = M.([| f |] (* B *)) +let _ = M.((* A *) [| f |] (* B *)) +let _ = M.((* A *) [| f |] (* B *) [@warning "foo"] (* C *)) +let _ = M.([ f ] [@warning "foo"]) +let _ = M.((* A *) [ f ]) +let _ = M.([ f ] (* B *)) +let _ = M.([ f ] (* B *)) (* after *) +let _ = M.((* A *) [ f ] (* B *)) +let _ = M.((* A *) [ f ] (* B *) [@warning "foo"] (* C *)) +let _ = M.((f, f) [@warning "foo"]) +let _ = M.((* A *) (f, f)) +let _ = M.((f, f) (* B *)) +let _ = M.((* A *) (f, f) (* B *)) +let _ = M.((* A *) ((f, f) (* B *) [@warning "foo"] (* C *))) + +let _ = + let _ = + Fooooooo. + [ + (swap_1_c, { minimum_transfert_amount = 0. }); + (swap_2_c, { minimum_transfert_amount = 0. }); + (swap_3_c, { minimum_transfert_amount = 0. }); + ] + in + () + +let _ = + match Uri.scheme uri with + | Some _ -> ( + (* we have an absoluteURI *) + Uri.( + match path uri with "" -> with_path uri "/" | _ -> uri)) + +(* Ptyp_open *) + +let _ : M.(foo * M.(bar)) = () +let _ : M.(foo) * M.(bar) = () +let _ : M.([ `Foo of foo ]) = () +let _ : M.N.(foo) = () + +let _ : + M.( + foooooooooooooooooooooooooooooooooooooooo + * foooooooooooooooooooooooooooooooooooooooo) = + () + +let _ : + M.( + [ `Foo of + foooooooooooooooooooooooooooooooooooooooo + * foooooooooooooooooooooooooooooooooooooooo ]) = + () + +let _ : M.((foo[@attr])) = () +let _ : (M.(foo)[@attr]) = () +let _ : M.((foo[@attr] [@attr])) = () +let _ : (M.((foo[@attr]))[@attr]) = () diff --git a/test/passing/refs.default/open_types.ml.ref b/test/passing/refs.default/open_types.ml.ref new file mode 100644 index 0000000000..cdedac2e82 --- /dev/null +++ b/test/passing/refs.default/open_types.ml.ref @@ -0,0 +1,2 @@ +type t = .. +type sub_system = t = .. diff --git a/test/passing/refs.default/option.ml.err b/test/passing/refs.default/option.ml.err new file mode 100644 index 0000000000..9cad5c9da5 --- /dev/null +++ b/test/passing/refs.default/option.ml.err @@ -0,0 +1,29 @@ +File "option.ml", line 63, characters 17-28: +63 | [@@@ocamlformat "margin=90"] + ^^^^^^^^^^^ +Warning 47 [attribute-payload]: illegal payload for attribute 'ocamlformat'. +margin not allowed here + +File "option.ml", line 13, characters 3-19: +13 | [@@ocamlformat.typo "if-then-else=keyword-first"] + ^^^^^^^^^^^^^^^^ +Warning 47 [attribute-payload]: illegal payload for attribute 'ocamlformat.typo'. +Invalid format: Unknown suffix "typo" + +File "option.ml", line 21, characters 3-14: +21 | [@@ocamlformat 1, "if-then-else=keyword-first"] + ^^^^^^^^^^^ +Warning 47 [attribute-payload]: illegal payload for attribute 'ocamlformat'. +Invalid format: String expected + +File "option.ml", line 28, characters 3-14: +28 | [@@ocamlformat "if-then-else=bad"] + ^^^^^^^^^^^ +Warning 47 [attribute-payload]: illegal payload for attribute 'ocamlformat'. +For option "if-then-else": invalid value 'bad', expected one of 'compact', 'fit-or-vertical', 'vertical', 'keyword-first' or 'k-r' + +File "option.ml", line 39, characters 14-25: +39 | [@@ocamlformat "if-then-else=bad"] + ^^^^^^^^^^^ +Warning 47 [attribute-payload]: illegal payload for attribute 'ocamlformat'. +For option "if-then-else": invalid value 'bad', expected one of 'compact', 'fit-or-vertical', 'vertical', 'keyword-first' or 'k-r' diff --git a/test/passing/refs.default/option.ml.ref b/test/passing/refs.default/option.ml.ref new file mode 100644 index 0000000000..0feb85224c --- /dev/null +++ b/test/passing/refs.default/option.ml.ref @@ -0,0 +1,64 @@ +let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +[@@ocamlformat "if-then-else=keyword-first"] + +let _ = + if b then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +[@@ocamlformat.typo "if-then-else=keyword-first"] + +let _ = + if b then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +[@@ocamlformat 1, "if-then-else=keyword-first"] + +let _ = + if b then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +[@@ocamlformat "if-then-else=bad"] + +module M = struct + [@@@ocamlformat "if-then-else=keyword-first"] + + let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + [@@ocamlformat "if-then-else=bad"] + + let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + + let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + + [@@@ocamlformat "if-then-else=compact"] + + let _ = + if b then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +end + +[@@@ocamlformat "margin=90"] diff --git a/test/passing/refs.default/override.ml.ref b/test/passing/refs.default/override.ml.ref new file mode 100644 index 0000000000..c542af8e09 --- /dev/null +++ b/test/passing/refs.default/override.ml.ref @@ -0,0 +1,5 @@ +let _ = {<x = (x : t)>} +let _ = {<x = ((x [@a]) : (t[@b])) [@c]>} +let _ = {<x>} +let _ = {<x = x [@a]>} +let _ = {<x>} diff --git a/test/passing/refs.default/parens_tuple_patterns.ml.ref b/test/passing/refs.default/parens_tuple_patterns.ml.ref new file mode 100644 index 0000000000..d28cc345d8 --- /dev/null +++ b/test/passing/refs.default/parens_tuple_patterns.ml.ref @@ -0,0 +1,5 @@ +let a, b = (1, 2) +let[@ocamlformat "parens-tuple-patterns=always"] (a, b) = (1, 2) +let[@ocamlformat "parens-tuple-patterns=always"] M.(a, b) = () +let[@ocamlformat "parens-tuple-patterns=multi-line-only"] a, b = (1, 2) +let[@ocamlformat "parens-tuple-patterns=multi-line-only"] M.(a, b) = () diff --git a/test/passing/tests/polytypes-default.ml.ref b/test/passing/refs.default/polytypes.ml.ref similarity index 100% rename from test/passing/tests/polytypes-default.ml.ref rename to test/passing/refs.default/polytypes.ml.ref diff --git a/test/passing/refs.default/pre_post_extensions.ml.ref b/test/passing/refs.default/pre_post_extensions.ml.ref new file mode 100644 index 0000000000..17c2e567f3 --- /dev/null +++ b/test/passing/refs.default/pre_post_extensions.ml.ref @@ -0,0 +1,15 @@ +let f x = + [%Trace.call fun { pf } -> pf "%i" x] + ; + print_int x ; + x + |> + [%Trace.retn fun { pf } -> pf "%i"] + +let f x = + [%Trace.call fun { pf } : t -> pf "%i" x] + ; + print_int x ; + x + |> + [%Trace.retn fun { pf } : t -> pf "%i"] diff --git a/test/passing/refs.default/precedence.ml.ref b/test/passing/refs.default/precedence.ml.ref new file mode 100644 index 0000000000..827acb39d7 --- /dev/null +++ b/test/passing/refs.default/precedence.ml.ref @@ -0,0 +1,3 @@ +a || (b && c);; +1 + (3 * 5);; +1 < 3 || b diff --git a/test/passing/refs.default/prefix_infix.ml.ref b/test/passing/refs.default/prefix_infix.ml.ref new file mode 100644 index 0000000000..aa15135f2f --- /dev/null +++ b/test/passing/refs.default/prefix_infix.ml.ref @@ -0,0 +1,15 @@ +let _ = List.filter (( != ) e) l +let _ = List.map (( != ) x) l +let _ = x != y +let _ = - !e +let _ = - !e.f +let z = (( ! ) ~x:4) 1 2 ~c:3 +let z = (( ! ) ~x:4 y z) 1 2 ~c:3 +let z = (( ! ) ~x:4 [@attr]) 1 2 ~c:3 +let z = (( ! ) [@attr]) 1 2 ~c:3 +let z = ( ! ) [@attr] +let i x = (!r [@attr]) x +let _ = ( * ) [@attr] +let _ = f (( * ) [@attr]);; + +( * ) [@attr] diff --git a/test/passing/refs.default/profiles.ml.ref b/test/passing/refs.default/profiles.ml.ref new file mode 100644 index 0000000000..612905711d --- /dev/null +++ b/test/passing/refs.default/profiles.ml.ref @@ -0,0 +1,7 @@ +let a = + aaaaaaaaaa + aaaaaaaaa + +let b = + bbbbbbbbbb + bbbbbbbbb diff --git a/test/passing/refs.default/profiles2.ml.ref b/test/passing/refs.default/profiles2.ml.ref new file mode 100644 index 0000000000..5b8c243632 --- /dev/null +++ b/test/passing/refs.default/profiles2.ml.ref @@ -0,0 +1,5 @@ +let a = + aaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaa + +let b = + bbbbbbbbbbbbbbbbbbvvbbb bbbvvvbbbbbbbbbbbbbbbbbbbb bbbbbbbbbbbbbbbbbbbbbb diff --git a/test/passing/refs.default/protected_object_types.ml.ref b/test/passing/refs.default/protected_object_types.ml.ref new file mode 100644 index 0000000000..78c4f34fd8 --- /dev/null +++ b/test/passing/refs.default/protected_object_types.ml.ref @@ -0,0 +1,74 @@ +(* Tests of special cases added to avoid emitting [>\] and [>\}], which are + keywords. *) + +(* Regression tests for https://github.com/ocaml-ppx/ocamlformat/issues/1295 + (unnecessary trailing spaces added after object types with attributes). *) + +type t = { foo : (< .. >[@a]) } +type t = { foo : < .. > [@a] } +type t = A of { foo : (< .. >[@a]) } +type t = A of { foo : < .. > [@a] } +type t = [ `Foo of (< .. >[@a]) ] +type t = [ `Foo of < .. > [@a] ] + +let _ = + object + inherit [b, (< f : unit >[@a])] foo + end + +module Space_around = struct + (* Ensure that the protection mechanism does not add extra spaces when + [--space-around-*] options are sufficient. *) + + module Records = struct + type t = { foo : < .. > } + type t = A of { foo : < .. > } + end + [@@ocamlformat "space-around-records = true"] + + module Variants = struct + type t = [ `Foo of < .. > ] + end + [@@ocamlformat "space-around-variants"] +end + +module Inside_payloads = struct + (* Regression tests for + https://github.com/ocaml-ppx/ocamlformat/issues/1267 (failure to protect + against object types inside extension and attribute payloads). *) + + let _ = [%ext: < .. > ] + + [%%ext: < .. > ] + + [%%ext + () + + type a = < f : t > ] + + [@@@a: val b : < .. > ] + + let _ = () [@a: val b : < .. > ] + let _ = () [@@a: val b : < .. > ] + + [@@@a: type x = < .. > ] + + [@@@a: + val x : t + + type x = < .. > ] + + [@@@a: type t = < .. > ] + [@@@a: type t = (< .. >[@a])] + [@@@a: type a = A of t | B of t | C of < .. > ] + [@@@a: type a = A of t | B of t | C of (t -> < .. >)] + [@@@a: type a += C of a * b * < .. > ] + [@@@a: type a += C of a * b * < .. > [@a]] + [@@@a: type a += C of (a -> b * < .. >)] + [@@@a: type a = t constraint t = < .. > ] + [@@@a: type a = t constraint t = (< .. >[@a])] + [@@@a: exception C of a * b * < .. > ] + + (* Simple attributes on exceptions not supported pre-4.08 *) + [@@@a: exception C of a * b * < .. > [@@a]] +end diff --git a/test/passing/refs.default/qtest.ml.err b/test/passing/refs.default/qtest.ml.err new file mode 100644 index 0000000000..1a25e98fce --- /dev/null +++ b/test/passing/refs.default/qtest.ml.err @@ -0,0 +1 @@ +Warning: qtest.ml:21 exceeds the margin diff --git a/test/passing/refs.default/qtest.ml.ref b/test/passing/refs.default/qtest.ml.ref new file mode 100644 index 0000000000..7515b70aea --- /dev/null +++ b/test/passing/refs.default/qtest.ml.ref @@ -0,0 +1,59 @@ +(*$T + false +*) + +(*$T foo + foo 0 ( + ) [1;2;3] = 6 (* hehe *) + foo 0 ( * ) [1;2;3] = 0 (* haha (*hoho *) *) + foo 1 ( * ) [4;5] = 20 + foo 12 ( + ) [] = 12 +*) + +(*$T foo + foo 1 ( * ) [4;5] = foo 2 ( * ) [1;5;2] +*) + +(*$= foo & ~printer:string_of_int + (foo 1 ( * ) [4;5]) (foo 2 ( * ) [1;5;2]) +*) + +(*$Q foo + Q.small_int (fun i-> foo i (+) [1;2;3] = List.fold_left (+) i [1;2;3]) + (Q.pair Q.small_int (Q.list Q.small_int)) (fun (i,l)-> foo i (+) l = List.fold_left (+) i l) +*) + +(*$R foo + let thing = foo 1 ( * ) + and li = [4;5] in + assert_bool "something_witty" (thing li = 20); + (* pertinent comment *) + assert_bool "something_wittier" (1=1) +*) + +(*$inject let brom = baz *) +(*$T brom + brom.[2] = 'z' +*) + +(*$T & + 1 = 2-1 + 2+3 \ + = \ + \ + 5 + + 1+1=2 +*) + +(*$T & 6 \ + & = + 2*3 +*) + +(*$Q & ~count:10 + (Q.small_int_corners ()) (fun n-> n+3 -2 -1 = abs n) +*) + +(*$Q & ~max_gen:1000000 ~count:1000000 + (Q.make (fun _ -> ())) (fun () -> true) +*) diff --git a/test/passing/refs.default/quoted_strings.ml.ref b/test/passing/refs.default/quoted_strings.ml.ref new file mode 100644 index 0000000000..05f2cb151a --- /dev/null +++ b/test/passing/refs.default/quoted_strings.ml.ref @@ -0,0 +1,37 @@ +let foo = {%foo| foooooooooooooo |} +let foo = (* A *) {%foo| foooooooooooooo |} (* B *) [@attr] (* C *) +let foo = (* A *) {%foo sep| foooooooooooooo |sep} +let foo = {%foo| foooooooooooooo |} [@@attr] +let foo = {%foo| foooooooooooooo |} (* A *) [@@attr] (* B *) +let foo = {%foo| foooooooooooooo |} [@attr] [@@attr] +let foo = {%foo| foooooooooooooo |} (* A *) [@attr] (* B *) [@@attr] +let foo = (* A *) {%foo| foooooooooooooo |} [@attr] (* B *) [@@attr] +let foo = (* A *) {%foo sep| foooooooooooooo |sep} (* B *) [@@attr] + +{%%foo| foooooooooooooo |} +{%%foo| foooooooooooooo |} (* A *) [@@attr] (* B *) +{%%foo sep| foooooooooooooo |sep} +{%%foo sep| foooooooooooooo |sep} (* A *) [@@attr] + +(* Structures *) +{%%M.foo| <hello>{x} |} +{%%M.foo bar| <hello>{|x|} |bar} + +(* Signatures *) +module type S = sig + {%%M.foo| <hello>{x} |} + {%%M.foo bar| <hello>{|x|} |bar} +end + +(* Expressions/Pattern/Types *) +let ({%M.foo| <hello>{x} |} : {%M.foo| <hello>{x} |}) = {%M.foo| <hello>{x} |} + +let ({%M.foo bar| <hello>{|x|} |bar} : {%M.foo bar| <hello>{|x|} |bar}) = + {%M.foo bar| <hello>{|x|} |bar} + +(* Multiline *) +{%%M.foo| + <hello> + {x} + </hello> +|} diff --git a/test/passing/refs.default/recmod.mli.ref b/test/passing/refs.default/recmod.mli.ref new file mode 100644 index 0000000000..e148ef2d46 --- /dev/null +++ b/test/passing/refs.default/recmod.mli.ref @@ -0,0 +1,19 @@ +module rec A : sig + type t = AA of B.t +end + +and B : sig + type t = BB of A.t +end + +include sig + (* a *) +end + +module type S = sig end + +module rec A : S +(** A *) + +and B : S +(** B *) diff --git a/test/passing/refs.default/record-402.ml.err b/test/passing/refs.default/record-402.ml.err new file mode 100644 index 0000000000..80db5a632d --- /dev/null +++ b/test/passing/refs.default/record-402.ml.err @@ -0,0 +1,2 @@ +Warning: record-402.ml:8 exceeds the margin +Warning: record-402.ml:16 exceeds the margin diff --git a/test/passing/refs.default/record-402.ml.ref b/test/passing/refs.default/record-402.ml.ref new file mode 100644 index 0000000000..994d023048 --- /dev/null +++ b/test/passing/refs.default/record-402.ml.ref @@ -0,0 +1,77 @@ +type t = { x : int; y : int } + +let _ = { x = 1; y = 2 } +let _ = { !e with a; b = c } +let _ = { !(f e) with a; b = c } + +let _ = + { + !looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + with + a; + b = c; + } + +let _ = + { + !looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + with + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; + b = c; + } + +let _ = { (a : t) with a; b; c } +let _ = { (f a) with a; b; c } + +let _ = + { + (a; + a) + with + a; + b; + c; + } + +let _ = { (if x then e else e) with e1; e2 } +let _ = { (match x with x -> e) with e1; e2 } +let _ = { (x : x) with e1; e2 } +let _ = { (x :> x) with e1; e2 } +let _ = { (x#x) with e1; e2 } +let f ~l:{ f; g } = e +let f ?l:({ f; g }) = e +let _ = { a; b = (match b with `A -> A | `B -> B | `C -> C : c); c } +let a () = A { A.a = (a : t) } +let x = { aaaaaaaaaa (* b *); b } +let x = { aaaaaaaaaa (* b *); b } + +type t = { a : (module S); b : (module S) } + +let _ = { a = (module M : S); b = (module M : S) } +let to_string { x; _ (* we should print y *) } = string_of_int x +let { x = (x : t) } = x + +type t = { + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : + YYYYYYYYYYYYYYYYYYYYY.t; + (* ____________________________________ *) +} + +let _ = + let _ = function + | { + foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo; + foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo; + } -> + () + in + () + +let foo + ({ + foooooooooooooooooooooo; + invalidation_trace; + access_trace; + must_be_valid_reason; + } [@warning "+missing-record-field-pattern"]) = + () diff --git a/test/passing/refs.default/record-loose.ml.err b/test/passing/refs.default/record-loose.ml.err new file mode 100644 index 0000000000..92246b33b4 --- /dev/null +++ b/test/passing/refs.default/record-loose.ml.err @@ -0,0 +1,2 @@ +Warning: record-loose.ml:8 exceeds the margin +Warning: record-loose.ml:16 exceeds the margin diff --git a/test/passing/tests/record-default.ml.ref b/test/passing/refs.default/record-loose.ml.ref similarity index 100% rename from test/passing/tests/record-default.ml.ref rename to test/passing/refs.default/record-loose.ml.ref diff --git a/test/passing/refs.default/record-tight_decl.ml.err b/test/passing/refs.default/record-tight_decl.ml.err new file mode 100644 index 0000000000..ca23ce923b --- /dev/null +++ b/test/passing/refs.default/record-tight_decl.ml.err @@ -0,0 +1,2 @@ +Warning: record-tight_decl.ml:8 exceeds the margin +Warning: record-tight_decl.ml:16 exceeds the margin diff --git a/test/passing/refs.default/record-tight_decl.ml.ref b/test/passing/refs.default/record-tight_decl.ml.ref new file mode 100644 index 0000000000..1c3094105b --- /dev/null +++ b/test/passing/refs.default/record-tight_decl.ml.ref @@ -0,0 +1,77 @@ +type t = { x: int; y: int } + +let _ = { x = 1; y = 2 } +let _ = { !e with a; b = c } +let _ = { !(f e) with a; b = c } + +let _ = + { + !looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + with + a; + b = c; + } + +let _ = + { + !looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + with + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; + b = c; + } + +let _ = { (a : t) with a; b; c } +let _ = { (f a) with a; b; c } + +let _ = + { + (a; + a) + with + a; + b; + c; + } + +let _ = { (if x then e else e) with e1; e2 } +let _ = { (match x with x -> e) with e1; e2 } +let _ = { (x : x) with e1; e2 } +let _ = { (x :> x) with e1; e2 } +let _ = { (x#x) with e1; e2 } +let f ~l:{ f; g } = e +let f ?l:({ f; g }) = e +let _ = { a; b = (match b with `A -> A | `B -> B | `C -> C : c); c } +let a () = A { A.a : t } +let x = { aaaaaaaaaa (* b *); b } +let x = { aaaaaaaaaa (* b *); b } + +type t = { a: (module S); b: (module S) } + +let _ = { a = (module M : S); b = (module M : S) } +let to_string { x; _ (* we should print y *) } = string_of_int x +let { x : t } = x + +type t = { + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx: + YYYYYYYYYYYYYYYYYYYYY.t; + (* ____________________________________ *) +} + +let _ = + let _ = function + | { + foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo; + foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo; + } -> + () + in + () + +let foo + ({ + foooooooooooooooooooooo; + invalidation_trace; + access_trace; + must_be_valid_reason; + } [@warning "+missing-record-field-pattern"]) = + () diff --git a/test/passing/refs.default/record.ml.err b/test/passing/refs.default/record.ml.err new file mode 100644 index 0000000000..977292ad59 --- /dev/null +++ b/test/passing/refs.default/record.ml.err @@ -0,0 +1,2 @@ +Warning: record.ml:8 exceeds the margin +Warning: record.ml:16 exceeds the margin diff --git a/test/passing/refs.default/record.ml.ref b/test/passing/refs.default/record.ml.ref new file mode 100644 index 0000000000..3d9dcff4a2 --- /dev/null +++ b/test/passing/refs.default/record.ml.ref @@ -0,0 +1,77 @@ +type t = { x: int; y: int } + +let _ = { x= 1; y= 2 } +let _ = { !e with a; b= c } +let _ = { !(f e) with a; b= c } + +let _ = + { + !looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + with + a; + b= c; + } + +let _ = + { + !looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + with + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; + b= c; + } + +let _ = { (a : t) with a; b; c } +let _ = { (f a) with a; b; c } + +let _ = + { + (a; + a) + with + a; + b; + c; + } + +let _ = { (if x then e else e) with e1; e2 } +let _ = { (match x with x -> e) with e1; e2 } +let _ = { (x : x) with e1; e2 } +let _ = { (x :> x) with e1; e2 } +let _ = { (x#x) with e1; e2 } +let f ~l:{ f; g } = e +let f ?l:({ f; g }) = e +let _ = { a; b= (match b with `A -> A | `B -> B | `C -> C : c); c } +let a () = A { A.a: t } +let x = { aaaaaaaaaa (* b *); b } +let x = { aaaaaaaaaa (* b *); b } + +type t = { a: (module S); b: (module S) } + +let _ = { a= (module M : S); b= (module M : S) } +let to_string { x; _ (* we should print y *) } = string_of_int x +let { x: t } = x + +type t = { + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx: + YYYYYYYYYYYYYYYYYYYYY.t; + (* ____________________________________ *) +} + +let _ = + let _ = function + | { + foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo; + foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo; + } -> + () + in + () + +let foo + ({ + foooooooooooooooooooooo; + invalidation_trace; + access_trace; + must_be_valid_reason; + } [@warning "+missing-record-field-pattern"]) = + () diff --git a/test/passing/refs.default/record_punning.ml.ref b/test/passing/refs.default/record_punning.ml.ref new file mode 100644 index 0000000000..c158ac273c --- /dev/null +++ b/test/passing/refs.default/record_punning.ml.ref @@ -0,0 +1,69 @@ +[%sexp { x : int; y : string }] + +let _ = fun { x : int; y : string } -> () +let _ = { A.b = A.b } +let { A.b } = x + +let _ = + object + method x = {<x = A.x>} + end + +let a = { x } +let b = { x : a } +let c = { x : a :> b } +let d = { x = x [@foo] } +let e = { x = y } +let { x } = f +let deep = { x; y = { x } } +let x = { (*test*) aaa : aa; bbb : bb } +let x = { aaa : aa (* A *); bbb : bb } +let x = { aaa : aa; (* A *) bbb : bb } +let x = { (*test*) aaa : aa = aa; bbb : bb } +let x = { aaa : aa (* A *) = aa; bbb : bb } +let x = { aaa : aa = (* A *) aa; bbb : bb } +let x = { aaa : aa; (* A *) bbb : bb } +let { (*a*) a : a } = e +let { a (*a*) : a } = e +let { a : (*a*) a } = e +let { a : a (*a*) } = e + +let _ = + (* comment here *) + { + (* comment here *) + aaaaaaaaaaaaaaaaaaaaaaaaaaaaa = aaaaaaaaaaaaaaaaaaaaaaaa; + bbbbbbbbbbbb : bbbbbbbbbbb = bbbbbbbbbbbbbbbbb; + } + +let { + (* comment here *) + aaaaaaaaaaaaaaaaaaaaaaaaaaaaa = aaaaaaaaaaaaaaaaaaaaaaaa; + bbbbbbbbbbbb : bbbbbbbbbbb = bbbbbbbbbbbbbbbbb; + } = + e + +type t = { + (* comment here *) + aaaaaaaaaaaaaaaaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaaaaaaaaaa; + bbbbbbbbbbbb : bbbbbbbbbbb; +} + +let _ = x { a = (a' : string); b = (b' : string) } +let _ = x { a : string = a'; b : string = b' } +let _ = x { a = (a' : string); b : string = b' } +let _ = x { a : string = a'; b = (b' : string) } +let x = function { a = (_ : string); _ } -> () +let x = function { a : string = _; _ } -> () +let { x (*b*) : z } = e +let { (* a *) x (*b*) : (* c *) z (* d *) } = e +let _ = { (*a*) x (*b*) : (*c*) t (*d*) :> (*e*) t (*f*) = (*g*) e (*h*) } + +type t = C of (*a*) { (*b*) x (*c*) : (*d*) t (*e*) } (*f*) +type t = C : (*a*) { (*b*) x (*c*) : (*d*) t (*e*) } (*f*) -> t + +let _ = { x : t } +let _ = { x : t :> t } +let _ = { x :> t } +let _ = { x : t :> t } +let _ = { x : t :> t } diff --git a/test/passing/refs.default/reformat_string.ml.ref b/test/passing/refs.default/reformat_string.ml.ref new file mode 100644 index 0000000000..edef79e0e9 --- /dev/null +++ b/test/passing/refs.default/reformat_string.ml.ref @@ -0,0 +1,10 @@ +let _ = 'a' +let _ = 'a' +let _ = (* test *) "asd" +let _ = "asd" +let _ = (* te""st *) "asd" +let _ = "asd" +let _ = 'a' +let _ = 'a' +let _ = function 'a' .. 'z' -> () +let _ = "aaa\n\n e" diff --git a/test/passing/refs.default/refs.ml.err b/test/passing/refs.default/refs.ml.err new file mode 100644 index 0000000000..22e404a3e3 --- /dev/null +++ b/test/passing/refs.default/refs.ml.err @@ -0,0 +1,2 @@ +Warning: refs.ml:2 exceeds the margin +Warning: refs.ml:4 exceeds the margin diff --git a/test/passing/refs.default/refs.ml.ref b/test/passing/refs.default/refs.ml.ref new file mode 100644 index 0000000000..e4f5824432 --- /dev/null +++ b/test/passing/refs.default/refs.ml.ref @@ -0,0 +1,20 @@ +let _ = + x := 2; + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx := + 2; + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx := + something very + looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong; + xxxxxxxxxxxxx xxxxxxxxxxx xxxxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx xxxxxxxxxx + xxxxxxxxxxxxx + := something very + looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong; + xx := + something very loooooooooooooooooooooooooooooooooooooooooooooooooooooooong; + if something loooooooooooong then + xx := + something very loooooooooooooooooooooooooooooooooooooooooooooooooooooooong +;; + +if row <> row' && col <> col' then + b.(row').(col') <- remove b.(row').(col') value diff --git a/test/passing/refs.default/remove_extra_parens.ml.ref b/test/passing/refs.default/remove_extra_parens.ml.ref new file mode 100644 index 0000000000..592fb0f3de --- /dev/null +++ b/test/passing/refs.default/remove_extra_parens.ml.ref @@ -0,0 +1 @@ +let f = function [ { xxxxxx }; { yyyyyyyy } ] -> () diff --git a/test/passing/refs.default/repl.ml.ref b/test/passing/refs.default/repl.ml.ref new file mode 100644 index 0000000000..247b48ce62 --- /dev/null +++ b/test/passing/refs.default/repl.ml.ref @@ -0,0 +1,7 @@ +# let x = 2;; +val x : int = 2 +# x + 2;; +- : int = 4 +# let x = 2 and y = 3 in + x + y + ;; diff --git a/test/passing/refs.default/repl.mli.err b/test/passing/refs.default/repl.mli.err new file mode 100644 index 0000000000..edd60385cd --- /dev/null +++ b/test/passing/refs.default/repl.mli.err @@ -0,0 +1,4 @@ +Warning: Invalid documentation comment: +File "repl.mli", line 23, character 12 to line 26, character 4: +invalid code block: not expecting: unexpected character 'v'. +Hint: did you forget a space after the '#' at the start of the line? diff --git a/test/passing/tests/repl.mli.ref b/test/passing/refs.default/repl.mli.ref similarity index 95% rename from test/passing/tests/repl.mli.ref rename to test/passing/refs.default/repl.mli.ref index 00d6ab9122..372d8a2f95 100644 --- a/test/passing/tests/repl.mli.ref +++ b/test/passing/refs.default/repl.mli.ref @@ -1,3 +1,4 @@ +type t = k (** VALID BLOCKS: Block delimiters should be on their own line: @@ -31,8 +32,8 @@ Many toplevel phrases without output: {[ - # let x = 2 ;; - # x + 2 ;; + # let x = 2;; + # x + 2;; # let x = 2 and y = 3 in x + y ;; @@ -40,9 +41,9 @@ Many toplevel phrases with output: {[ - # let x = 2 ;; + # let x = 2;; val x : int = 2 - # x + 2 ;; + # x + 2;; - : int = 4 # let x = 2 and y = 3 in x + y @@ -73,7 +74,6 @@ x + 1 ;; ]} *) -type t = k (** INVALID BLOCKS: The formatting of invalid blocks is preserved. diff --git a/test/passing/refs.default/revapply_ext.ml.ref b/test/passing/refs.default/revapply_ext.ml.ref new file mode 100644 index 0000000000..84ad583dbb --- /dev/null +++ b/test/passing/refs.default/revapply_ext.ml.ref @@ -0,0 +1,9 @@ +let _ = + () + (* one *) + |> + [%ext fun _ -> ()] + +let _ = () + |> + [%ext fun _ -> ()] diff --git a/test/passing/refs.default/send.ml.ref b/test/passing/refs.default/send.ml.ref new file mode 100644 index 0000000000..ae33034cd1 --- /dev/null +++ b/test/passing/refs.default/send.ml.ref @@ -0,0 +1,9 @@ +let x obj = obj#hello () +let x obj_f = (obj_f ())#hello () +let f obj = obj#hello_some_pretty_long_one ~with_labels:true () + +let f obj = + obj#hello_some_pretty_long_one ~with_labels:true "desjd\ndijsde\n" + {md| +In **markdown** +|md} diff --git a/test/passing/refs.default/sequence-preserve.ml.ref b/test/passing/refs.default/sequence-preserve.ml.ref new file mode 100644 index 0000000000..ec76786f48 --- /dev/null +++ b/test/passing/refs.default/sequence-preserve.ml.ref @@ -0,0 +1,145 @@ +let read_traces filename = + let ic = open_in_bin filename in + read_hashtable ~t:[%t: contracts_trace] 0 40 ic tbl1; + read_hashtable ~t:[%t: variables_trace] 40 70 ic tbl2; + read_hashtable ~t:[%t: expressions_trace] 70 100 ic tbl3; + close_in ic + +let foo x y = + do_some_setup y; + do_some_setup y; + + do_some_setup y; + do_some_setup y; + important_function x + +let foo x y = + do_some_setup y; + important_function x + +let foo x y = + do_some_setup y; + + important_function x + +let foo x y = + do_some_setup x; + do_some_setup y; + + (* Empty line before *) + important_function x; + another_important_function x y; + + cleanup x y + +let foo x y = + do_some_setup x; + do_some_setup y; + (* No empty line *) + important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + do_some_setup x; + do_some_setup y; + + (* Empty line after *) + important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + do_some_setup x; + do_some_setup y; + + (* Empty line after, this above *) + important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + do_some_setup x; + do_some_setup y; + + (* Empty line before, this under *) important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + (* Break should not cause an empty line *) + do_some_setup x; + do_some_setup y; + + important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + do_some_setup x; + let () = do_some_setup y in + (* Empty line after let *) + + important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + do_some_setup x; + let () = do_some_setup y in + + (* Empty line after let but before comment *) + important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + (* in should not cause an empty line *) + let () = do_some_setup x in + do_some_setup y; + + important_function x; + another_important_function x y; + cleanup x y + +let _ = + some statement; + (* comment with an empty line in it + + tricky *) + an other statement + +let foo x y = + do_some_setup x; + let* () = do_some_setup y in + + (* Empty line after letop *) + important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + (* letop in should not cause an empty line *) + let* () = do_some_setup x in + do_some_setup y; + + important_function x; + another_important_function x y; + cleanup x y + +let _ = + (* This let will wrap *) + let x = 1 in + + (* some comment *) + next statement + +[@@@ocamlformat "indicate-multiline-delimiters=closing-on-separate-line"] + +let foo x y = + lazy + ( fooooooooooooooooooooooo; + fooooooooooooooooooooooo; + foooooooooooooooooooooooooo; + fooooooooooooooooooooooooo + ) diff --git a/test/passing/refs.default/sequence.ml.ref b/test/passing/refs.default/sequence.ml.ref new file mode 100644 index 0000000000..b84db9cf51 --- /dev/null +++ b/test/passing/refs.default/sequence.ml.ref @@ -0,0 +1,131 @@ +let read_traces filename = + let ic = open_in_bin filename in + read_hashtable ~t:[%t: contracts_trace] 0 40 ic tbl1; + read_hashtable ~t:[%t: variables_trace] 40 70 ic tbl2; + read_hashtable ~t:[%t: expressions_trace] 70 100 ic tbl3; + close_in ic + +let foo x y = + do_some_setup y; + do_some_setup y; + do_some_setup y; + do_some_setup y; + important_function x + +let foo x y = + do_some_setup y; + important_function x + +let foo x y = + do_some_setup y; + important_function x + +let foo x y = + do_some_setup x; + do_some_setup y; + (* Empty line before *) + important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + do_some_setup x; + do_some_setup y; + (* No empty line *) + important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + do_some_setup x; + do_some_setup y; + (* Empty line after *) + important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + do_some_setup x; + do_some_setup y; + (* Empty line after, this above *) + important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + do_some_setup x; + do_some_setup y; + (* Empty line before, this under *) important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + (* Break should not cause an empty line *) + do_some_setup x; + do_some_setup y; + important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + do_some_setup x; + let () = do_some_setup y in + (* Empty line after let *) + important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + do_some_setup x; + let () = do_some_setup y in + (* Empty line after let but before comment *) + important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + (* in should not cause an empty line *) + let () = do_some_setup x in + do_some_setup y; + important_function x; + another_important_function x y; + cleanup x y + +let _ = + some statement; + (* comment with an empty line in it + + tricky *) + an other statement + +let foo x y = + do_some_setup x; + let* () = do_some_setup y in + (* Empty line after letop *) + important_function x; + another_important_function x y; + cleanup x y + +let foo x y = + (* letop in should not cause an empty line *) + let* () = do_some_setup x in + do_some_setup y; + important_function x; + another_important_function x y; + cleanup x y + +let _ = + (* This let will wrap *) + let x = 1 in + (* some comment *) + next statement + +[@@@ocamlformat "indicate-multiline-delimiters=closing-on-separate-line"] + +let foo x y = + lazy + ( fooooooooooooooooooooooo; + fooooooooooooooooooooooo; + foooooooooooooooooooooooooo; + fooooooooooooooooooooooooo + ) diff --git a/test/passing/refs.default/shebang.ml.ref b/test/passing/refs.default/shebang.ml.ref new file mode 100644 index 0000000000..c050a01742 --- /dev/null +++ b/test/passing/refs.default/shebang.ml.ref @@ -0,0 +1,5 @@ +#!/usr/bin/env ocaml + +type t = { a : a; b : b } + +let f x = x diff --git a/test/passing/refs.default/shortcut_ext_attr.ml.ref b/test/passing/refs.default/shortcut_ext_attr.ml.ref new file mode 100644 index 0000000000..f87312c053 --- /dev/null +++ b/test/passing/refs.default/shortcut_ext_attr.ml.ref @@ -0,0 +1,126 @@ +(* Expressions *) +let () = + let%foo[@foo] x = 3 and[@foo] y = 4 in + [%foo + (let module M = M in + ()) + [@foo]]; + [%foo M.(()) [@foo]]; + [%foo fun [@foo] x -> ()]; + [%foo function[@foo] x -> ()]; + [%foo try[@foo] () with _ -> ()]; + [%foo if [@foo] () then () else ()]; + [%foo + while () do + () + done + [@foo]]; + [%foo + for x = () to () do + () + done + [@foo]]; + ();%foo + (); + [%foo assert true [@foo]]; + [%foo lazy x [@foo]]; + [%foo object end [@foo]]; + [%foo (3 [@foo])]; + [%foo new x [@foo]]; + [%foo + match[@foo] () with + | [%foo? + (* Pattern expressions *) + ((lazy x) [@foo])] -> + () + | [%foo? ((exception x) [@foo])] -> ()] + +(* Class expressions *) +class x = + fun [@foo] x -> + let[@foo] x = 33 in + object + inherit x [@@foo] + val x = 333 [@@foo] + val virtual x : t [@@foo] + val! mutable x = 3 [@@foo] + method x = 3 [@@foo] + method virtual x : t [@@foo] + method! private x = 3 [@@foo] + initializer x [@@foo] + end + [@foo] + +(* Class type expressions *) +class type t = object + inherit t [@@foo] + val x : t [@@foo] + val mutable x : t [@@foo] + method x : t [@@foo] + method private x : t [@@foo] + constraint t = t' [@@foo] +end[@foo] + +(* Type expressions *) +type t = [%foo: ((module M)[@foo])] + +(* Module expressions *) +module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo])) + +(* Module type expression *) +module type S = functor [@foo1] + (M : S) + -> functor + (_ : (module type of M) [@foo2]) + -> sig end [@foo3] + +(* Structure items *) +let%foo[@foo] x = 4 +and[@foo] y = x + +type%foo t = int [@@foo] +and t = int [@@foo] + +type%foo t += T [@@foo] + +class%foo x = x [@@foo] + +class type%foo x = x [@@foo] + +external%foo x : _ = "" [@@foo] + +exception%foo X [@@foo] + +module%foo M = M [@@foo] + +module%foo rec M : S = M [@@foo] +and M : S = M [@@foo] + +module type%foo S = S [@@foo] + +include%foo M [@@foo] +open%foo M [@@foo] + +(* Signature items *) +module type S = sig + [%%foo: val x : t [@@foo]] + [%%foo: external x : t = "" [@@foo]] + + type%foo t = int [@@foo] + and t' = int [@@foo] + + [%%foo: type t += T [@@foo]] + [%%foo: exception X [@@foo]] + [%%foo: module [@foo] M : S] + + [%%foo: + module [@foo] rec M : S + and [@foo] M : S] + + [%%foo: module [@foo] M = M] + [%%foo: module type S = S [@@foo]] + [%%foo: include M [@@foo]] + [%%foo: open M [@@foo]] + [%%foo: class x : t [@@foo]] + [%%foo: class type x = x [@@foo]] +end diff --git a/test/passing/refs.default/sig_value.mli.ref b/test/passing/refs.default/sig_value.mli.ref new file mode 100644 index 0000000000..b561f83404 --- /dev/null +++ b/test/passing/refs.default/sig_value.mli.ref @@ -0,0 +1,21 @@ +val f : f:(string[@att]) (** doc *) -> unit + +val f : + f:(string[@att]) + (** doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc + doc doc doc doc doc *) -> + unit + +val f : f:(string[@att]) -> unit +val f : f:string (** doc *) -> unit +val f : f:(string * string[@att]) (** doc *) -> unit + +val f : + f:(string * string[@att]) + (** doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc + doc doc doc doc doc *) -> + unit + +val f : f:(string * string[@att]) -> unit +val f : f:string * string (** doc *) -> unit +val f : t/1 -> f:(unit -> unit t/2) -> unit M/2.t diff --git a/test/passing/refs.default/single_line.mli.ref b/test/passing/refs.default/single_line.mli.ref new file mode 100644 index 0000000000..9e7e313eab --- /dev/null +++ b/test/passing/refs.default/single_line.mli.ref @@ -0,0 +1,6 @@ +[@@@ocamlformat "module-item-spacing=compact"] + +val xx_xxxxxxxx : t -> bool +val xx_xxxxxxxx : t -> bool +val xxxxxxxx : t -> [> `Xxxxxxx | `Xxxxxxxxxxx | `Xxxxxxxxxx | `Xxxxxxxxxxxxx ] +val xxxxx : t -> t -> t Xxx.t option diff --git a/test/passing/refs.default/skip.ml.ref b/test/passing/refs.default/skip.ml.ref new file mode 100644 index 0000000000..33eb9d37b7 --- /dev/null +++ b/test/passing/refs.default/skip.ml.ref @@ -0,0 +1,113 @@ +[@@@ocamlformat "disable"] + +let this_won't_be_formatted = + 1 +[@@@ocamlformat "enable"] + +let x = function + | A , B -> 1 + | BBB , _ -> 2 + | CCCcccc , CCCCCCCC -> 3 +[@@ocamlformat "disable"] + +let x = function A, B -> 1 | BBB, _ -> 2 | CCCcccc, CCCCCCCC -> 3 + +module S = struct + let x = function + | A , B -> 1 + | BBB , _ -> 2 + | CCCcccc , CCCCCCCC -> (* cmt about 3 *) 3 + [@@ocamlformat "disable"] +end + +module S = struct + let x = function + | A, B -> 1 + | BBB, _ -> 2 + | CCCcccc, CCCCCCCC -> (* cmt about 3 *) 3 + + let x = function + | A, B -> 1 + | BBB, _ -> 2 + | CCCcccc, CCCCCCCC -> (* cmt about 3 *) 3 + + [@@@ocamlformat "disable"] + + let x = function + | A , B -> 1 + | BBB , _ -> 2 + | CCCcccc , CCCCCCCC -> (* cmt about 3 *) 3 + + [@@@ocamlformat "enable"] + + let x = function + | A, B -> 1 + | BBB, _ -> 2 + | CCCcccc, CCCCCCCC -> (* cmt about 3 *) 3 + + let _ = + let x = 3 in + match[@ocamlformat "disable"] x,y with + | Some _, None -> test + | None , Some _ -> test + | Some _, Some _ -> test + | None , None -> test +end + +let x = function + | A, B -> 1 + | BBB, _ -> 2 + | CCCcccc, CCCCCCCC -> (* cmt about 3 *) 3 + +module type S = sig + type t = int * int + [@@ocamlformat "disable"] + + [@@@ocamlformat "disable"] + + val x : a : t -> b: t + -> c : t -> unit +end + +let x = fun fc -> + let x = 3 in + match x,y with + | Some _, None -> test + | None , Some _ -> test + | Some _, Some _ -> test + | None , None -> test + [@@ocamlformat "disable"] + +let x = + fun[@ocamlformat "disable"] fc -> + let x = 3 in + match x,y with + | Some _, None -> test + | None , Some _ -> test + | Some _, Some _ -> test + | None , None -> test + +let _ = (x [@ocamlformat "disable"] [@test? _ when e [@test 2]]) 3 + +let _ = + let module X = struct + let x = 4 + end in + X.x + +let _ = + let module X = + struct + let x = 4 + end [@ocamlformat "disable"] + in + X.x + +let _ = + let module X = struct + module S = + struct + let x = 4 + end [@ocamlformat "disable"] + end in + X.x diff --git a/test/passing/refs.default/source.ml.err b/test/passing/refs.default/source.ml.err new file mode 100644 index 0000000000..cec42f35a1 --- /dev/null +++ b/test/passing/refs.default/source.ml.err @@ -0,0 +1,5 @@ +Warning: source.ml:925 exceeds the margin +Warning: source.ml:1000 exceeds the margin +Warning: source.ml:6620 exceeds the margin +Warning: source.ml:7078 exceeds the margin +Warning: source.ml:8655 exceeds the margin diff --git a/test/passing/tests/source-conventional.ml.ref b/test/passing/refs.default/source.ml.ref similarity index 100% rename from test/passing/tests/source-conventional.ml.ref rename to test/passing/refs.default/source.ml.ref diff --git a/test/passing/refs.default/str_value.ml.ref b/test/passing/refs.default/str_value.ml.ref new file mode 100644 index 0000000000..7eb40e2fb1 --- /dev/null +++ b/test/passing/refs.default/str_value.ml.ref @@ -0,0 +1,75 @@ +module Compact = struct + [@@@ocamlformat "let-binding-spacing=compact"] + + (* doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + (** doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd + + and f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd + + let f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd +end + +module Nl = struct + [@@@ocamlformat "let-binding-spacing=sparse"] + + (* doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + (** doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd + + + and f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd + + + let f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd +end + +module Double = struct + [@@@ocamlformat "let-binding-spacing=double-semicolon"] + + (* doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + (** doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd + + and f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd + ;; + + let f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd + ;; +end diff --git a/test/passing/refs.default/string.ml.ref b/test/passing/refs.default/string.ml.ref new file mode 100644 index 0000000000..ec4c671569 --- /dev/null +++ b/test/passing/refs.default/string.ml.ref @@ -0,0 +1,45 @@ +let f = function + | () -> + raise_s + [%sexp + "Xxxx \036 \036 \036 \036 \036 \036 \036 xxx xxxx xx xxxxxx xx xxx \ + xxxxxxx xxxxxx, xxxxxxx xxxxxxxxxx xx xxxx. Xxxx.", + 0] + +let _ = "\010\xFFa\o123\n\\\u{12345}aa🐪🐪🐪🐪🐪\n" + +let _ = + "aaaaaaaaaaaaaaaaaaaaaaaaa\n\ + \tbbbbbbbbbbbbbbbbbbbbbbbbbb\n\ + \tcccccccccccccccccc\n\ + \t" + +let _ = + "aaaaaaaaaaaaaaaaaaaaaaaaa\n\ + \ bbbbbbbbbbbbbbbbbbbbbbbbbb\n\ + \ cccccccccccccccccc\n\ + \ " + +let _ = ('\xff', '\255', '\n') +let f = function '\xff' .. '\255' -> () +let f ("test" [@test "test"]) = 2;; + +"@\n\ +\ xxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxx \ + xxxxxxxx xxxxxxxxxxx" + +external%c print : str:string -> d:int -> void + = {| + printf("%s (%d)\n",$str,$d); + fflush(stdout); +|} + {| + printf("%s (%d)\n",$str,$d); + fflush(stdout); +|} + +external x : t = (* a *) "x" (* b *) "y" (* c *) + +external x : t + = (* aaaaaaa aaaaaa aaaaaa *) {|xxxxxx xxxxx xxxx|} + (* bbbbbb bbbbb bbbbbb *) {|yyyy yyyy yyyyy|} (* cccccc ccccc cccccc *) diff --git a/test/passing/refs.default/string_array.ml.ref b/test/passing/refs.default/string_array.ml.ref new file mode 100644 index 0000000000..342d26ad42 --- /dev/null +++ b/test/passing/refs.default/string_array.ml.ref @@ -0,0 +1,14 @@ +(f ()).(2) <- e;; +(f ()).(2) <- (e, 2);; +((f ()).(2) <- e), 2;; +(f ()).[2] <- e;; +(f ()).[2] <- (e, 2);; +((f ()).[2] <- e), 2;; +(f ()).{2} <- e;; +(f ()).{2} <- (e, 2);; +((f ()).{2} <- e), 2;; +(f ()).{2, 2, 2, 2} <- e;; +(f ()).{2, 2, 2, 2} <- (e, 2);; +((f ()).{2, 2, 2, 2} <- e), 2 + +let l = [| (fun x -> x); (fun y -> y) |] diff --git a/test/passing/refs.default/string_wrapping.ml.ref b/test/passing/refs.default/string_wrapping.ml.ref new file mode 100644 index 0000000000..862ef631cc --- /dev/null +++ b/test/passing/refs.default/string_wrapping.ml.ref @@ -0,0 +1,3 @@ +let universal_declaration = + "-1- Programs are born and remain free and equal under the law;\n\ + distinctions can only be based on the common good." diff --git a/test/passing/refs.default/symbol.ml.ref b/test/passing/refs.default/symbol.ml.ref new file mode 100644 index 0000000000..8a42674d84 --- /dev/null +++ b/test/passing/refs.default/symbol.ml.ref @@ -0,0 +1,21 @@ +let op = if b then ( * ) else ( + ) in +() +;; + +assert ( * );; +( * ) [@a];; +assert (( * ) [@a]) + +module Array = struct + let ( .!() ) = Array.unsafe_get + let ( .!()<- ) = Array.unsafe_set +end + +let ( .!() ), ( .!()<- ) = Array.((( .!() ) [@attr]), ( .!()<- )) +let _ = ( let++ ) [@attr];; + +( let++ ) [@attr] + +let ( let++ ), (( and++ ) [@attr]) = X.((( let++ ) [@attr]), ( and++ )) +let is_empty = function [] -> true | ( :: ) _ -> false +let is_empty = (( :: ), ( :: ) 1, (Foo) 2) diff --git a/test/passing/refs.default/tag_only.ml.ref b/test/passing/refs.default/tag_only.ml.ref new file mode 100644 index 0000000000..37cb41c7ce --- /dev/null +++ b/test/passing/refs.default/tag_only.ml.ref @@ -0,0 +1,194 @@ +open Module +(** @deprecated *) + +open Module +(** abc + + @deprecated *) + +open Module +(** @author A *) + +open Module +(** @inline *) + +include Abc +(** @inline *) + +(** @inline *) +include struct + type t +end + +include (Module : Type) +(** @inline *) + +module A = B +(** @inline *) + +(** @inline *) +module A : sig + type t +end = struct + type t +end + +(** @inline *) +module rec A : sig + type t +end = struct + type t +end + +(** @author B *) +and B : sig + type t +end = struct + type t +end + +module type A = B +(** @deprecated abc *) + +(** @deprecated abc *) +module type A = sig + type t +end + +(** @open *) +module A : sig + type t +end = + B + +open Module.With_veryyyyyy_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame +(** @deprecated *) + +include Module.With_very_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame +(** @deprecated *) + +module A = Module.With_very_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame +(** @deprecated *) + +(** @deprecated *) +type t = T + +type t = t +(** @deprecated *) + +(** @deprecated *) +let a = b + +(** @deprecated *) +type t = t +(** @deprecated *) + +class b = + object + method f = 0 + (** @deprecated *) + + inherit a + (** @deprecated *) + + val x = 1 + (** @deprecated *) + + constraint 'a = [> ] + (** @deprecated *) + + initializer do_init () + (** @deprecated *) + end + +[@@@ocamlformat "doc-comments-tag-only=fit"] + +open Module (** @deprecated *) + +open Module +(** abc + + @deprecated *) + +open Module (** @author A *) + +open Module (** @inline *) + +include Abc (** @inline *) + +(** @inline *) +include struct + type t +end + +include (Module : Type) (** @inline *) + +module A = B (** @inline *) + +(** @inline *) +module A : sig + type t +end = struct + type t +end + +(** @inline *) +module rec A : sig + type t +end = struct + type t +end + +(** @author B *) +and B : sig + type t +end = struct + type t +end + +module type A = B (** @deprecated abc *) + +(** @deprecated abc *) +module type A = sig + type t +end + +(** @open *) +module A : sig + type t +end = + B + +open Module.With_veryyyyyy_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame +(** @deprecated *) + +include Module.With_very_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame +(** @deprecated *) + +module A = Module.With_very_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame +(** @deprecated *) + +(** @deprecated *) +type t = T + +type t = t (** @deprecated *) + +(** @deprecated *) +let a = b + +(** @deprecated *) +type t = t +(** @deprecated *) + +class b = + object + method f = 0 (** @deprecated *) + + inherit a (** @deprecated *) + + val x = 1 (** @deprecated *) + + constraint 'a = [> ] (** @deprecated *) + + initializer do_init () (** @deprecated *) + end diff --git a/test/passing/refs.default/tag_only.mli.ref b/test/passing/refs.default/tag_only.mli.ref new file mode 100644 index 0000000000..c7d799e0dc --- /dev/null +++ b/test/passing/refs.default/tag_only.mli.ref @@ -0,0 +1,99 @@ +open Module +(** @deprecated *) + +open Module +(** abc + + @deprecated *) + +(** @inline *) +include sig + type t +end + +include Type +(** @inline *) + +include module type of Module +(** @inline *) + +module A : B +(** @deprecated *) + +(** @deprecated *) +module A : sig + type t +end + +module type A = B +(** @open *) + +(** @open *) +module type A = sig + type t +end + +(** @deprecated *) +type t = T + +type t = { a : int } +(** @deprecated *) + +type t = .. +(** @deprecated *) + +type t +(** @deprecated *) + +type t = t +(** @deprecated *) + +val a : b +(** @deprecated *) + +[@@@ocamlformat "doc-comments-tag-only=fit"] + +open Module (** @deprecated *) + +open Module +(** abc + + @deprecated *) + +(** @inline *) +include sig + type t +end + +include Type (** @inline *) + +include module type of Module (** @inline *) + +module A : B (** @deprecated *) + +(** @deprecated *) +module A : sig + type t +end + +module type A = B (** @open *) + +(** @open *) +module type A = sig + type t +end + +(** @deprecated *) +type t = T + +type t = { a : int } +(** @deprecated *) + +type t = .. (** @deprecated *) + +type t (** @deprecated *) + +type t = t (** @deprecated *) + +val a : b +(** @deprecated *) diff --git a/test/passing/refs.default/try_with_or_pattern.ml.ref b/test/passing/refs.default/try_with_or_pattern.ml.ref new file mode 100644 index 0000000000..e05912b146 --- /dev/null +++ b/test/passing/refs.default/try_with_or_pattern.ml.ref @@ -0,0 +1,5 @@ +let[@ocamlformat "break-cases=all"] _ = + try () with + | End_of_file + | Not_found -> + () diff --git a/test/passing/refs.default/tuple.ml.ref b/test/passing/refs.default/tuple.ml.ref new file mode 100644 index 0000000000..06ff64ad02 --- /dev/null +++ b/test/passing/refs.default/tuple.ml.ref @@ -0,0 +1,47 @@ +let _ = + match w with + | A -> ([], A.(B (C (f x))), None, f x y, g y x) + | B -> (a, b, c, d, e, f) + | C -> + ( [], + A.(B (C (this is very looooooooooooooooooooooooooooooooooooong x))), + None, + f x y, + g y x ) + +let _ = [%ext 1, 2, 3] + +let _ = + [%ext + loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong, + 2, + 3] + +type t = int [@@deriving 1, 2, 3] + +type t = int +[@@deriving + sexp, + compare, + loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong] + +let _ = + ( 1, + 2, + 3, + looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong + ) + +let _ = (1, 2, 3, short);; + +1, +2, +3, +looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong +;; + +1, 2, 3, short + +let (a, b) : int * int = + let (a, b) : int * int = (1, 2) in + (a, b) diff --git a/test/passing/refs.default/tuple_less_parens.ml.ref b/test/passing/refs.default/tuple_less_parens.ml.ref new file mode 100644 index 0000000000..1526fc56ad --- /dev/null +++ b/test/passing/refs.default/tuple_less_parens.ml.ref @@ -0,0 +1,45 @@ +let _ = + match w with + | A -> [], A.(B (C (f x))), None, f x y, g y x + | B -> a, b, c, d, e, f + | C -> + ( [], + A.(B (C (this is very looooooooooooooooooooooooooooooooooooong x))), + None, + f x y, + g y x ) + +let _ = [%ext 1, 2, 3] + +let _ = + [%ext + loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong, + 2, + 3] + +type t = int [@@deriving 1, 2, 3] + +type t = int +[@@deriving + sexp, + compare, + loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong] + +let _ = + ( 1, + 2, + 3, + looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong ) + +let _ = 1, 2, 3, short;; + +1, +2, +3, +looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong +;; + +1, 2, 3, short + +(* make sure to not drop parens for local open. *) +let _ = A.(1, 2) diff --git a/test/passing/refs.default/tuple_type_parens.ml.ref b/test/passing/refs.default/tuple_type_parens.ml.ref new file mode 100644 index 0000000000..0e488468e3 --- /dev/null +++ b/test/passing/refs.default/tuple_type_parens.ml.ref @@ -0,0 +1,4 @@ +type t = A of a * (b -> unit) + +type u = B of c +and v = d * e diff --git a/test/passing/refs.default/type_and_constraint.ml.ref b/test/passing/refs.default/type_and_constraint.ml.ref new file mode 100644 index 0000000000..abea6fd5cd --- /dev/null +++ b/test/passing/refs.default/type_and_constraint.ml.ref @@ -0,0 +1 @@ +type 'a t = 'a list constraint 'a = [< `X ] diff --git a/test/passing/refs.default/type_annotations.ml.ref b/test/passing/refs.default/type_annotations.ml.ref new file mode 100644 index 0000000000..0f2de2117c --- /dev/null +++ b/test/passing/refs.default/type_annotations.ml.ref @@ -0,0 +1,7 @@ +let f = match None with (_ : int option) -> true +let f (x : int) : int = e +let f (x as y : int) : int = e +let f ((x : int) as y) : int = e +let f ((x : int) : int) = e +let _ = match x with exception (e : exn) -> true | _ -> false +let x = (0 : int :> int) diff --git a/test/passing/refs.default/types-compact-space_around-docked.ml.ref b/test/passing/refs.default/types-compact-space_around-docked.ml.ref new file mode 100644 index 0000000000..4b18ade556 --- /dev/null +++ b/test/passing/refs.default/types-compact-space_around-docked.ml.ref @@ -0,0 +1,201 @@ +type uu = A of int | B of (< leq : 'a > as 'a) +type uu = A of int | B of (< leq : 'a > as 'a) * 'a +type uu = A of (int as 'a) | B of 'a * (< leq : 'a > as 'a) +type uu += A of (int as 'a) +type uu += B of 'a * (< leq : 'a > as 'a) + +let _ = ignore Async_unix.Fd.(([ stdin (); stdout (); stderr () ] : t list)) + +type t = { x : int } +type t = { a : int; b : int } +type t = [ `A | `B ] + +type loooooooooong_type = { + looooooooooooong_field : looooooooooooong_type; + field2 : type2; +} + +type t = A of (int * int) * int +type t = A of int * int +type t = A of (int * int) + +let _ = match x with Some (Some None) -> t + +type t = .. +type t = private .. +type t = u = private .. +type t += A +type t += B = A +type 'a foo = A of (int -> 'a) +type 'a foo += A of (int -> 'a) +type 'a foo += A : (int -> 'a) -> int foo +type t = [ | a ] +type t = private [< a ] +type t = private [> a ] +type t = [ a | b ] +type t = [ a | b | `C ] +type t = [ `a | b ] +type t = | +type t = [> ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int + | `Looooooooooooooooooooong_variant of string ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int (** Doc *) + | `Looooooooooooooooooooong_variant of string (* Comment *) ] + +let (`A | `B) [@bar] = () + +type t = + | Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string + | `Unstable of Location.t * string ] ] + +val x : + [ `X of int + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +val x : + [ `X of + int + * foooooooooooooo + * fooooooooooo + * fooooooooooo foooooooooo + * foooooooooooo + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +val x : + [ `X of int (* booooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +val x : + [ `X of + int + * foooooooooooooo + * fooooooooooo + * fooooooooooo foooooooooo + * foooooooooooo + (* boooooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +type voting_period = + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + +(** foooooooo *) +type voting_period = + (* foooooooooooo *) + (* foooooooooo ooooooooooooooooo ooooooooooooo *) + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind + (* fooooooooooooooo oooooooooooooooooooo ooooooooooooooooooooo *) + (* fooooo *) = + (* foooooooooo *) + | Proposal + | Testing_vote (** fooooooooooo *) + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher = { + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; +} + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher = + ( 'context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint ) + templ_matcher = { + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; +} + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher += + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + +module type A = sig + type t := A.t + + type a := A.a + and b := A.b + + type t := A.t = A | B + type t := A | B + + type t := A.t = { a : int; b : int } + and t := { a : int; b : int } + + type t := A.t = .. + type t := .. +end + +type t = [ `A (** A *) | `B [@b] (** B *) | (p[@p]) (* P *) ] + +type foooooooooooooooo = + ?fooooooooo:(string -> unit) -> + ?fooooooooooooo: + (string -> + string -> + int -> + string -> + string option foooooooooooooooooooooooo) -> + fooooo:string -> + ?fooooooooo:(unit -> unit Fooo.t) -> + ?fooooooo:bool -> + string option Foooooooo.t + +type ' a' t = ' a' +type ' a' t = ' a' option +type ' a' t = int as ' a' +type t = { a : ' a'. ' a' t' } + +type t = + | Foo + | (* Redirect (None, lib) looks up lib in the same database *) + Redirect of db option * (Loc.t * Lib_name.t) + +type t = + | Foo + | Store of { + exp1 : Exp.t; + typ : Typ.t option; + exp2 : Exp.t; + loc : Location.t; + } (** *exp1 <- exp2 with exp2:typ *) diff --git a/test/passing/refs.default/types-compact-space_around.ml.ref b/test/passing/refs.default/types-compact-space_around.ml.ref new file mode 100644 index 0000000000..4b18ade556 --- /dev/null +++ b/test/passing/refs.default/types-compact-space_around.ml.ref @@ -0,0 +1,201 @@ +type uu = A of int | B of (< leq : 'a > as 'a) +type uu = A of int | B of (< leq : 'a > as 'a) * 'a +type uu = A of (int as 'a) | B of 'a * (< leq : 'a > as 'a) +type uu += A of (int as 'a) +type uu += B of 'a * (< leq : 'a > as 'a) + +let _ = ignore Async_unix.Fd.(([ stdin (); stdout (); stderr () ] : t list)) + +type t = { x : int } +type t = { a : int; b : int } +type t = [ `A | `B ] + +type loooooooooong_type = { + looooooooooooong_field : looooooooooooong_type; + field2 : type2; +} + +type t = A of (int * int) * int +type t = A of int * int +type t = A of (int * int) + +let _ = match x with Some (Some None) -> t + +type t = .. +type t = private .. +type t = u = private .. +type t += A +type t += B = A +type 'a foo = A of (int -> 'a) +type 'a foo += A of (int -> 'a) +type 'a foo += A : (int -> 'a) -> int foo +type t = [ | a ] +type t = private [< a ] +type t = private [> a ] +type t = [ a | b ] +type t = [ a | b | `C ] +type t = [ `a | b ] +type t = | +type t = [> ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int + | `Looooooooooooooooooooong_variant of string ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int (** Doc *) + | `Looooooooooooooooooooong_variant of string (* Comment *) ] + +let (`A | `B) [@bar] = () + +type t = + | Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string + | `Unstable of Location.t * string ] ] + +val x : + [ `X of int + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +val x : + [ `X of + int + * foooooooooooooo + * fooooooooooo + * fooooooooooo foooooooooo + * foooooooooooo + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +val x : + [ `X of int (* booooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +val x : + [ `X of + int + * foooooooooooooo + * fooooooooooo + * fooooooooooo foooooooooo + * foooooooooooo + (* boooooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +type voting_period = + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + +(** foooooooo *) +type voting_period = + (* foooooooooooo *) + (* foooooooooo ooooooooooooooooo ooooooooooooo *) + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind + (* fooooooooooooooo oooooooooooooooooooo ooooooooooooooooooooo *) + (* fooooo *) = + (* foooooooooo *) + | Proposal + | Testing_vote (** fooooooooooo *) + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher = { + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; +} + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher = + ( 'context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint ) + templ_matcher = { + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; +} + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher += + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + +module type A = sig + type t := A.t + + type a := A.a + and b := A.b + + type t := A.t = A | B + type t := A | B + + type t := A.t = { a : int; b : int } + and t := { a : int; b : int } + + type t := A.t = .. + type t := .. +end + +type t = [ `A (** A *) | `B [@b] (** B *) | (p[@p]) (* P *) ] + +type foooooooooooooooo = + ?fooooooooo:(string -> unit) -> + ?fooooooooooooo: + (string -> + string -> + int -> + string -> + string option foooooooooooooooooooooooo) -> + fooooo:string -> + ?fooooooooo:(unit -> unit Fooo.t) -> + ?fooooooo:bool -> + string option Foooooooo.t + +type ' a' t = ' a' +type ' a' t = ' a' option +type ' a' t = int as ' a' +type t = { a : ' a'. ' a' t' } + +type t = + | Foo + | (* Redirect (None, lib) looks up lib in the same database *) + Redirect of db option * (Loc.t * Lib_name.t) + +type t = + | Foo + | Store of { + exp1 : Exp.t; + typ : Typ.t option; + exp2 : Exp.t; + loc : Location.t; + } (** *exp1 <- exp2 with exp2:typ *) diff --git a/test/passing/refs.default/types-compact.ml.ref b/test/passing/refs.default/types-compact.ml.ref new file mode 100644 index 0000000000..4b18ade556 --- /dev/null +++ b/test/passing/refs.default/types-compact.ml.ref @@ -0,0 +1,201 @@ +type uu = A of int | B of (< leq : 'a > as 'a) +type uu = A of int | B of (< leq : 'a > as 'a) * 'a +type uu = A of (int as 'a) | B of 'a * (< leq : 'a > as 'a) +type uu += A of (int as 'a) +type uu += B of 'a * (< leq : 'a > as 'a) + +let _ = ignore Async_unix.Fd.(([ stdin (); stdout (); stderr () ] : t list)) + +type t = { x : int } +type t = { a : int; b : int } +type t = [ `A | `B ] + +type loooooooooong_type = { + looooooooooooong_field : looooooooooooong_type; + field2 : type2; +} + +type t = A of (int * int) * int +type t = A of int * int +type t = A of (int * int) + +let _ = match x with Some (Some None) -> t + +type t = .. +type t = private .. +type t = u = private .. +type t += A +type t += B = A +type 'a foo = A of (int -> 'a) +type 'a foo += A of (int -> 'a) +type 'a foo += A : (int -> 'a) -> int foo +type t = [ | a ] +type t = private [< a ] +type t = private [> a ] +type t = [ a | b ] +type t = [ a | b | `C ] +type t = [ `a | b ] +type t = | +type t = [> ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int + | `Looooooooooooooooooooong_variant of string ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int (** Doc *) + | `Looooooooooooooooooooong_variant of string (* Comment *) ] + +let (`A | `B) [@bar] = () + +type t = + | Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string + | `Unstable of Location.t * string ] ] + +val x : + [ `X of int + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +val x : + [ `X of + int + * foooooooooooooo + * fooooooooooo + * fooooooooooo foooooooooo + * foooooooooooo + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +val x : + [ `X of int (* booooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +val x : + [ `X of + int + * foooooooooooooo + * fooooooooooo + * fooooooooooo foooooooooo + * foooooooooooo + (* boooooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +type voting_period = + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + +(** foooooooo *) +type voting_period = + (* foooooooooooo *) + (* foooooooooo ooooooooooooooooo ooooooooooooo *) + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind + (* fooooooooooooooo oooooooooooooooooooo ooooooooooooooooooooo *) + (* fooooo *) = + (* foooooooooo *) + | Proposal + | Testing_vote (** fooooooooooo *) + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher = { + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; +} + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher = + ( 'context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint ) + templ_matcher = { + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; +} + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher += + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + +module type A = sig + type t := A.t + + type a := A.a + and b := A.b + + type t := A.t = A | B + type t := A | B + + type t := A.t = { a : int; b : int } + and t := { a : int; b : int } + + type t := A.t = .. + type t := .. +end + +type t = [ `A (** A *) | `B [@b] (** B *) | (p[@p]) (* P *) ] + +type foooooooooooooooo = + ?fooooooooo:(string -> unit) -> + ?fooooooooooooo: + (string -> + string -> + int -> + string -> + string option foooooooooooooooooooooooo) -> + fooooo:string -> + ?fooooooooo:(unit -> unit Fooo.t) -> + ?fooooooo:bool -> + string option Foooooooo.t + +type ' a' t = ' a' +type ' a' t = ' a' option +type ' a' t = int as ' a' +type t = { a : ' a'. ' a' t' } + +type t = + | Foo + | (* Redirect (None, lib) looks up lib in the same database *) + Redirect of db option * (Loc.t * Lib_name.t) + +type t = + | Foo + | Store of { + exp1 : Exp.t; + typ : Typ.t option; + exp2 : Exp.t; + loc : Location.t; + } (** *exp1 <- exp2 with exp2:typ *) diff --git a/test/passing/refs.default/types-indent.ml.ref b/test/passing/refs.default/types-indent.ml.ref new file mode 100644 index 0000000000..25ea1a6b58 --- /dev/null +++ b/test/passing/refs.default/types-indent.ml.ref @@ -0,0 +1,201 @@ +type uu = A of int | B of (< leq : 'a > as 'a) +type uu = A of int | B of (< leq : 'a > as 'a) * 'a +type uu = A of (int as 'a) | B of 'a * (< leq : 'a > as 'a) +type uu += A of (int as 'a) +type uu += B of 'a * (< leq : 'a > as 'a) + +let _ = ignore Async_unix.Fd.(([ stdin (); stdout (); stderr () ] : t list)) + +type t = { x : int } +type t = { a : int; b : int } +type t = [ `A | `B ] + +type loooooooooong_type = { + looooooooooooong_field : looooooooooooong_type; + field2 : type2; + } + +type t = A of (int * int) * int +type t = A of int * int +type t = A of (int * int) + +let _ = match x with Some (Some None) -> t + +type t = .. +type t = private .. +type t = u = private .. +type t += A +type t += B = A +type 'a foo = A of (int -> 'a) +type 'a foo += A of (int -> 'a) +type 'a foo += A : (int -> 'a) -> int foo +type t = [ | a ] +type t = private [< a ] +type t = private [> a ] +type t = [ a | b ] +type t = [ a | b | `C ] +type t = [ `a | b ] +type t = | +type t = [> ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int + | `Looooooooooooooooooooong_variant of string ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int (** Doc *) + | `Looooooooooooooooooooong_variant of string (* Comment *) ] + +let (`A | `B) [@bar] = () + +type t = + | Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string + | `Unstable of Location.t * string ] ] + +val x : + [ `X of int + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +val x : + [ `X of + int + * foooooooooooooo + * fooooooooooo + * fooooooooooo foooooooooo + * foooooooooooo + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +val x : + [ `X of int (* booooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +val x : + [ `X of + int + * foooooooooooooo + * fooooooooooo + * fooooooooooo foooooooooo + * foooooooooooo + (* boooooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +type voting_period = + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + +(** foooooooo *) +type voting_period = + (* foooooooooooo *) + (* foooooooooo ooooooooooooooooo ooooooooooooo *) + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind + (* fooooooooooooooo oooooooooooooooooooo ooooooooooooooooooooo *) + (* fooooo *) = + (* foooooooooo *) + | Proposal + | Testing_vote (** fooooooooooo *) + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher = { + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + } + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher = + ( 'context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint ) + templ_matcher = { + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + } + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher += + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + +module type A = sig + type t := A.t + + type a := A.a + and b := A.b + + type t := A.t = A | B + type t := A | B + + type t := A.t = { a : int; b : int } + and t := { a : int; b : int } + + type t := A.t = .. + type t := .. +end + +type t = [ `A (** A *) | `B [@b] (** B *) | (p[@p]) (* P *) ] + +type foooooooooooooooo = + ?fooooooooo:(string -> unit) -> + ?fooooooooooooo: + (string -> + string -> + int -> + string -> + string option foooooooooooooooooooooooo) -> + fooooo:string -> + ?fooooooooo:(unit -> unit Fooo.t) -> + ?fooooooo:bool -> + string option Foooooooo.t + +type ' a' t = ' a' +type ' a' t = ' a' option +type ' a' t = int as ' a' +type t = { a : ' a'. ' a' t' } + +type t = + | Foo + | (* Redirect (None, lib) looks up lib in the same database *) + Redirect of db option * (Loc.t * Lib_name.t) + +type t = + | Foo + | Store of { + exp1 : Exp.t; + typ : Typ.t option; + exp2 : Exp.t; + loc : Location.t; + } (** *exp1 <- exp2 with exp2:typ *) diff --git a/test/passing/refs.default/types-sparse-space_around.ml.ref b/test/passing/refs.default/types-sparse-space_around.ml.ref new file mode 100644 index 0000000000..0f993349b3 --- /dev/null +++ b/test/passing/refs.default/types-sparse-space_around.ml.ref @@ -0,0 +1,256 @@ +type uu = + | A of int + | B of (< leq : 'a > as 'a) + +type uu = + | A of int + | B of (< leq : 'a > as 'a) * 'a + +type uu = + | A of (int as 'a) + | B of 'a * (< leq : 'a > as 'a) + +type uu += A of (int as 'a) +type uu += B of 'a * (< leq : 'a > as 'a) + +let _ = ignore Async_unix.Fd.(([ stdin (); stdout (); stderr () ] : t list)) + +type t = { x : int } + +type t = { + a : int; + b : int; +} + +type t = + [ `A + | `B + ] + +type loooooooooong_type = { + looooooooooooong_field : looooooooooooong_type; + field2 : type2; +} + +type t = A of (int * int) * int +type t = A of int * int +type t = A of (int * int) + +let _ = match x with Some (Some None) -> t + +type t = .. +type t = private .. +type t = u = private .. +type t += A +type t += B = A +type 'a foo = A of (int -> 'a) +type 'a foo += A of (int -> 'a) +type 'a foo += A : (int -> 'a) -> int foo +type t = [ | a ] +type t = private [< a ] +type t = private [> a ] + +type t = + [ a + | b + ] + +type t = + [ a + | b + | `C + ] + +type t = + [ `a + | b + ] + +type t = | +type t = [> ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int + | `Looooooooooooooooooooong_variant of string + ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int (** Doc *) + | `Looooooooooooooooooooong_variant of string (* Comment *) + ] + +let (`A | `B) [@bar] = () + +type t = + | Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string + | `Unstable of Location.t * string + ] + ] + +val x : + [ `X of int + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x : + [ `X of + int + * foooooooooooooo + * fooooooooooo + * fooooooooooo foooooooooo + * foooooooooooo + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x : + [ `X of int (* booooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x : + [ `X of + int + * foooooooooooooo + * fooooooooooo + * fooooooooooo foooooooooo + * foooooooooooo + (* boooooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +type voting_period = + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + +(** foooooooo *) +type voting_period = + (* foooooooooooo *) + (* foooooooooo ooooooooooooooooo ooooooooooooo *) + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind + (* fooooooooooooooo oooooooooooooooooooo ooooooooooooooooooooo *) + (* fooooo *) = + (* foooooooooo *) + | Proposal + | Testing_vote (** fooooooooooo *) + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher = { + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; +} + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher = + ( 'context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint ) + templ_matcher = { + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; +} + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher += + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + +module type A = sig + type t := A.t + + type a := A.a + and b := A.b + + type t := A.t = + | A + | B + + type t := + | A + | B + + type t := A.t = { + a : int; + b : int; + } + + and t := { + a : int; + b : int; + } + + type t := A.t = .. + type t := .. +end + +type t = + [ `A (** A *) + | `B [@b] (** B *) + | (p[@p]) (* P *) + ] + +type foooooooooooooooo = + ?fooooooooo:(string -> unit) -> + ?fooooooooooooo: + (string -> + string -> + int -> + string -> + string option foooooooooooooooooooooooo) -> + fooooo:string -> + ?fooooooooo:(unit -> unit Fooo.t) -> + ?fooooooo:bool -> + string option Foooooooo.t + +type ' a' t = ' a' +type ' a' t = ' a' option +type ' a' t = int as ' a' +type t = { a : ' a'. ' a' t' } + +type t = + | Foo + | (* Redirect (None, lib) looks up lib in the same database *) + Redirect of db option * (Loc.t * Lib_name.t) + +type t = + | Foo + | Store of { + exp1 : Exp.t; + typ : Typ.t option; + exp2 : Exp.t; + loc : Location.t; + } (** *exp1 <- exp2 with exp2:typ *) diff --git a/test/passing/refs.default/types-sparse.ml.ref b/test/passing/refs.default/types-sparse.ml.ref new file mode 100644 index 0000000000..0f993349b3 --- /dev/null +++ b/test/passing/refs.default/types-sparse.ml.ref @@ -0,0 +1,256 @@ +type uu = + | A of int + | B of (< leq : 'a > as 'a) + +type uu = + | A of int + | B of (< leq : 'a > as 'a) * 'a + +type uu = + | A of (int as 'a) + | B of 'a * (< leq : 'a > as 'a) + +type uu += A of (int as 'a) +type uu += B of 'a * (< leq : 'a > as 'a) + +let _ = ignore Async_unix.Fd.(([ stdin (); stdout (); stderr () ] : t list)) + +type t = { x : int } + +type t = { + a : int; + b : int; +} + +type t = + [ `A + | `B + ] + +type loooooooooong_type = { + looooooooooooong_field : looooooooooooong_type; + field2 : type2; +} + +type t = A of (int * int) * int +type t = A of int * int +type t = A of (int * int) + +let _ = match x with Some (Some None) -> t + +type t = .. +type t = private .. +type t = u = private .. +type t += A +type t += B = A +type 'a foo = A of (int -> 'a) +type 'a foo += A of (int -> 'a) +type 'a foo += A : (int -> 'a) -> int foo +type t = [ | a ] +type t = private [< a ] +type t = private [> a ] + +type t = + [ a + | b + ] + +type t = + [ a + | b + | `C + ] + +type t = + [ `a + | b + ] + +type t = | +type t = [> ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int + | `Looooooooooooooooooooong_variant of string + ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int (** Doc *) + | `Looooooooooooooooooooong_variant of string (* Comment *) + ] + +let (`A | `B) [@bar] = () + +type t = + | Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string + | `Unstable of Location.t * string + ] + ] + +val x : + [ `X of int + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x : + [ `X of + int + * foooooooooooooo + * fooooooooooo + * fooooooooooo foooooooooo + * foooooooooooo + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x : + [ `X of int (* booooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x : + [ `X of + int + * foooooooooooooo + * fooooooooooo + * fooooooooooo foooooooooo + * foooooooooooo + (* boooooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +type voting_period = + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + +(** foooooooo *) +type voting_period = + (* foooooooooooo *) + (* foooooooooo ooooooooooooooooo ooooooooooooo *) + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind + (* fooooooooooooooo oooooooooooooooooooo ooooooooooooooooooooo *) + (* fooooo *) = + (* foooooooooo *) + | Proposal + | Testing_vote (** fooooooooooo *) + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher = { + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; +} + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher = + ( 'context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint ) + templ_matcher = { + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; +} + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher += + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + +module type A = sig + type t := A.t + + type a := A.a + and b := A.b + + type t := A.t = + | A + | B + + type t := + | A + | B + + type t := A.t = { + a : int; + b : int; + } + + and t := { + a : int; + b : int; + } + + type t := A.t = .. + type t := .. +end + +type t = + [ `A (** A *) + | `B [@b] (** B *) + | (p[@p]) (* P *) + ] + +type foooooooooooooooo = + ?fooooooooo:(string -> unit) -> + ?fooooooooooooo: + (string -> + string -> + int -> + string -> + string option foooooooooooooooooooooooo) -> + fooooo:string -> + ?fooooooooo:(unit -> unit Fooo.t) -> + ?fooooooo:bool -> + string option Foooooooo.t + +type ' a' t = ' a' +type ' a' t = ' a' option +type ' a' t = int as ' a' +type t = { a : ' a'. ' a' t' } + +type t = + | Foo + | (* Redirect (None, lib) looks up lib in the same database *) + Redirect of db option * (Loc.t * Lib_name.t) + +type t = + | Foo + | Store of { + exp1 : Exp.t; + typ : Typ.t option; + exp2 : Exp.t; + loc : Location.t; + } (** *exp1 <- exp2 with exp2:typ *) diff --git a/test/passing/refs.default/types.ml.ref b/test/passing/refs.default/types.ml.ref new file mode 100644 index 0000000000..4b18ade556 --- /dev/null +++ b/test/passing/refs.default/types.ml.ref @@ -0,0 +1,201 @@ +type uu = A of int | B of (< leq : 'a > as 'a) +type uu = A of int | B of (< leq : 'a > as 'a) * 'a +type uu = A of (int as 'a) | B of 'a * (< leq : 'a > as 'a) +type uu += A of (int as 'a) +type uu += B of 'a * (< leq : 'a > as 'a) + +let _ = ignore Async_unix.Fd.(([ stdin (); stdout (); stderr () ] : t list)) + +type t = { x : int } +type t = { a : int; b : int } +type t = [ `A | `B ] + +type loooooooooong_type = { + looooooooooooong_field : looooooooooooong_type; + field2 : type2; +} + +type t = A of (int * int) * int +type t = A of int * int +type t = A of (int * int) + +let _ = match x with Some (Some None) -> t + +type t = .. +type t = private .. +type t = u = private .. +type t += A +type t += B = A +type 'a foo = A of (int -> 'a) +type 'a foo += A of (int -> 'a) +type 'a foo += A : (int -> 'a) -> int foo +type t = [ | a ] +type t = private [< a ] +type t = private [> a ] +type t = [ a | b ] +type t = [ a | b | `C ] +type t = [ `a | b ] +type t = | +type t = [> ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int + | `Looooooooooooooooooooong_variant of string ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int (** Doc *) + | `Looooooooooooooooooooong_variant of string (* Comment *) ] + +let (`A | `B) [@bar] = () + +type t = + | Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string + | `Unstable of Location.t * string ] ] + +val x : + [ `X of int + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +val x : + [ `X of + int + * foooooooooooooo + * fooooooooooo + * fooooooooooo foooooooooo + * foooooooooooo + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +val x : + [ `X of int (* booooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +val x : + [ `X of + int + * foooooooooooooo + * fooooooooooo + * fooooooooooo foooooooooo + * foooooooooooo + (* boooooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) ] + +type voting_period = + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + +(** foooooooo *) +type voting_period = + (* foooooooooooo *) + (* foooooooooo ooooooooooooooooo ooooooooooooo *) + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind + (* fooooooooooooooo oooooooooooooooooooo ooooooooooooooooooooo *) + (* fooooo *) = + (* foooooooooo *) + | Proposal + | Testing_vote (** fooooooooooo *) + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher = { + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; +} + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher = + ( 'context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint ) + templ_matcher = { + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; +} + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher += + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + +module type A = sig + type t := A.t + + type a := A.a + and b := A.b + + type t := A.t = A | B + type t := A | B + + type t := A.t = { a : int; b : int } + and t := { a : int; b : int } + + type t := A.t = .. + type t := .. +end + +type t = [ `A (** A *) | `B [@b] (** B *) | (p[@p]) (* P *) ] + +type foooooooooooooooo = + ?fooooooooo:(string -> unit) -> + ?fooooooooooooo: + (string -> + string -> + int -> + string -> + string option foooooooooooooooooooooooo) -> + fooooo:string -> + ?fooooooooo:(unit -> unit Fooo.t) -> + ?fooooooo:bool -> + string option Foooooooo.t + +type ' a' t = ' a' +type ' a' t = ' a' option +type ' a' t = int as ' a' +type t = { a : ' a'. ' a' t' } + +type t = + | Foo + | (* Redirect (None, lib) looks up lib in the same database *) + Redirect of db option * (Loc.t * Lib_name.t) + +type t = + | Foo + | Store of { + exp1 : Exp.t; + typ : Typ.t option; + exp2 : Exp.t; + loc : Location.t; + } (** *exp1 <- exp2 with exp2:typ *) diff --git a/test/passing/refs.default/unary.ml.ref b/test/passing/refs.default/unary.ml.ref new file mode 100644 index 0000000000..f5428f13fc --- /dev/null +++ b/test/passing/refs.default/unary.ml.ref @@ -0,0 +1,34 @@ +let _ = ~+2 +let _ = 2 +let _ = + ~-3 +let _ = -3 +let _ = ~+.2 +let _ = +.2 +let _ = ~-.3 +let _ = ~-3. +let _ = ~-(f x y) +let _ = -f x y +let _ = -f x y +let x = - !p +let x = - !p +let y = -r.f +let y = -r.f +let x = ~- (!p) +let x = ~- (!p) +let y = ~-r.f +let y = ~-r.f + +let _ = +f x +and _ = -f x + +let _ = +f x +and _ = -f x + +let _ = +.f x +and _ = -.f x + +let _ = +.f x +and _ = -.f x + +let _ = ~-(f r.x) +let _ = -(!array_ref.(0)) diff --git a/test/passing/refs.default/unary_hash.ml.ref b/test/passing/refs.default/unary_hash.ml.ref new file mode 100644 index 0000000000..bcbc7537ca --- /dev/null +++ b/test/passing/refs.default/unary_hash.ml.ref @@ -0,0 +1,10 @@ +let f o x = o##x +let f x = !#x +let f x = ?#x +let f x = ~#x +let f o x = o#-#x +let f x = !-#x +let f x = ?-#x +let f x = ~-#x +let f x = ?#(x - y) +let f x = x + ?#(x + y) diff --git a/test/passing/refs.default/unicode.ml.err b/test/passing/refs.default/unicode.ml.err new file mode 100644 index 0000000000..c0a43c88ba --- /dev/null +++ b/test/passing/refs.default/unicode.ml.err @@ -0,0 +1,2 @@ +Warning: unicode.ml:5 exceeds the margin +Warning: unicode.ml:11 exceeds the margin diff --git a/test/passing/tests/unicode.ml.ref b/test/passing/refs.default/unicode.ml.ref similarity index 100% rename from test/passing/tests/unicode.ml.ref rename to test/passing/refs.default/unicode.ml.ref diff --git a/test/passing/refs.default/use_file.mlt.ref b/test/passing/refs.default/use_file.mlt.ref new file mode 100644 index 0000000000..938cdce59b --- /dev/null +++ b/test/passing/refs.default/use_file.mlt.ref @@ -0,0 +1,19 @@ +#p + +#p "a" + +#p 0;; + +0;; + +#p 0n + +#p M.T.r + +(* comments *) +(* comments *) + +let () = 3;; + +2;; +3 diff --git a/test/passing/refs.default/variants.ml.err b/test/passing/refs.default/variants.ml.err new file mode 100644 index 0000000000..b2ad274f05 --- /dev/null +++ b/test/passing/refs.default/variants.ml.err @@ -0,0 +1 @@ +Warning: variants.ml:1 exceeds the margin diff --git a/test/passing/refs.default/variants.ml.ref b/test/passing/refs.default/variants.ml.ref new file mode 100644 index 0000000000..2286b8c7f8 --- /dev/null +++ b/test/passing/refs.default/variants.ml.ref @@ -0,0 +1,15 @@ +type t = + [ (* xx *) `(* yy *) A (* zz *) | (* xx *) `B (* zz *) | `(* yy *) C (* zz *) ] + +let (* xx *) `(* yy *) A (* zz *) = x +let (* xx *) `B (* zz *) = x +let `(* yy *) C (* zz *) = x +let _ = (* xx *) `(* yy *) A (* zz *) +let _ = (* xx *) `B (* zz *) +let _ = `(* yy *) C (* zz *) + +type t = + [ `Fooooo + | (* Other inline element markup. *) + `Simple_reference of string + | `Fooooo ] diff --git a/test/passing/tests/verbatim_comments-wrap.ml.ref b/test/passing/refs.default/verbatim_comments-wrap.ml.ref similarity index 100% rename from test/passing/tests/verbatim_comments-wrap.ml.ref rename to test/passing/refs.default/verbatim_comments-wrap.ml.ref diff --git a/test/passing/tests/verbatim_comments.ml.ref b/test/passing/refs.default/verbatim_comments.ml.ref similarity index 100% rename from test/passing/tests/verbatim_comments.ml.ref rename to test/passing/refs.default/verbatim_comments.ml.ref diff --git a/test/passing/tests/w50.ml.ref b/test/passing/refs.default/w50.ml.ref similarity index 81% rename from test/passing/tests/w50.ml.ref rename to test/passing/refs.default/w50.ml.ref index 26ecf36099..211695b529 100644 --- a/test/passing/tests/w50.ml.ref +++ b/test/passing/refs.default/w50.ml.ref @@ -1,5 +1,6 @@ -(* When using [--no-comment-check] (to format code despite warning 50), We - should not complain if doc-comments start appearing in the AST. *) +(* When using [--no-comment-check] (to format code despite warning 50), + We should not complain if doc-comments start appearing in the AST. +*) module type T = sig val test_raises_some_exc : ('a -> 'b) -> 'a -> bool diff --git a/test/passing/refs.default/wrap_comments.ml.err b/test/passing/refs.default/wrap_comments.ml.err new file mode 100644 index 0000000000..8ae787c5a3 --- /dev/null +++ b/test/passing/refs.default/wrap_comments.ml.err @@ -0,0 +1,19 @@ +Warning: wrap_comments.ml:61 exceeds the margin +Warning: wrap_comments.ml:189 exceeds the margin +Warning: wrap_comments.ml:190 exceeds the margin +Warning: wrap_comments.ml:191 exceeds the margin +Warning: wrap_comments.ml:195 exceeds the margin +Warning: wrap_comments.ml:196 exceeds the margin +Warning: wrap_comments.ml:197 exceeds the margin +Warning: wrap_comments.ml:200 exceeds the margin +Warning: wrap_comments.ml:201 exceeds the margin +Warning: wrap_comments.ml:202 exceeds the margin +Warning: wrap_comments.ml:207 exceeds the margin +Warning: wrap_comments.ml:208 exceeds the margin +Warning: wrap_comments.ml:209 exceeds the margin +Warning: wrap_comments.ml:213 exceeds the margin +Warning: wrap_comments.ml:214 exceeds the margin +Warning: wrap_comments.ml:215 exceeds the margin +Warning: wrap_comments.ml:218 exceeds the margin +Warning: wrap_comments.ml:219 exceeds the margin +Warning: wrap_comments.ml:220 exceeds the margin diff --git a/test/passing/refs.default/wrap_comments.ml.ref b/test/passing/refs.default/wrap_comments.ml.ref new file mode 100644 index 0000000000..03584d146d --- /dev/null +++ b/test/passing/refs.default/wrap_comments.ml.ref @@ -0,0 +1,232 @@ +[@@@ocamlformat "wrap-comments=true"] + +type t = + | Aaaaaaaaaa + (* Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod + tempor incididunt ut labore et dolore magna aliqua. *) + | Bbbbbbbbbb + +let _ = + [ + "a"; + "b" (* first line second line *); + "c" (* first line + + second line *); + "d" (* first line + + second line *); + "e" (* first line + + second line *); + "f" (* first line + + second line *); + "g"; + ] + +let _ = + let _ = + (* This is indented 7 This 0 *) + 0 + in + 0 + +let _ = + (*no space before no space after*) + 0 + +let _ = + (* blah blah *) + () + +(* + * foo + * bar + *) + +(* * foo bar *) + +let _ = f (* foo *) a + +(* 1 + * + 2 + * --- + * 3 + *) + +[@@@ocamlformat "wrap-comments=false"] + +type t = + | Aaaaaaaaaa + (* Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. *) + | Bbbbbbbbbb + +let rex = + Pcre.regexp + ("^[0-9]{2}" + (* xxxxxxxxxxx *) + ^ "(.{12})" + (* xxxxxxxxxxxxxxxxxx *) + ^ "(.{4})" + (* xxxxxxxxxxxx *) + ^ "([0-9]{3})" + (* xxxxxxxx *) + ^ "(.{60})" + (* xxxxxxxxxxxxxxxxxxxx *) + ^ "(.{12})" + (* xxxxxxxxxxxxxxx *) + ^ "(.{12})" + (* xxxxxxxxxxxxxxxxxxx *) + ^ "([0-9]{3})" + (* xxxxxxxxxxxxxxxxxxxxxxxxx *) + ^ "([0-9]{3})" + (* xxxxxxxxxxx *) + ^ "(.{15})" + (* xxxxxxxxxxxxxxxxxx *) + ^ "([0-9]{7})" + (* xxxxxxxxxxxxx *) + ^ "(.{10})" + (* xxxxxxxxxxxxx *) + ^ date_fmt + (* xxxxxxxxxxxxx *) + ^ "([0-9]{18})" + (* xxxxx *) + ^ "(.)" + (* xxxxxxxxxxx *) + ^ "([0-9]{3})" + (* xxxxxxxxxxxxxx *) + ^ "(.{15})" + (* xxxxxxxxxxxxxxxxxxxx *) + ^ "(.{3})" + (* xxxxxxxxxx *) + ^ "(.{27})$") + +type foo = { + some_field : int; + (* long long long long long long long long long long long long long long + * long long long long *) + another_field : string; +} + +let _ = + [ + "a"; + "b" (* first line + second line *); + "c" (* first line + + second line + *); + "d" (* first line + + + second line *); + "e" (* first line + + second line + *); + "f" (* first line + + second line + + + *); + "g"; + ] + +let _ = + let _ = + (* This is indented 7 +This 0 *) + 0 + in + 0 + +let _ = + (*no space before + no space after*) + 0 + +let _ = + (*no space before + just newline after +*) + 0 + +let _ = + (* Optimal 5-element sorting network: + + {v + 1--o-----o-----o--------------1 + | | | + 2--o-----|--o--|-----o--o-----2 + | | | | | + 3--------o--o--|--o--|--o-----3 + | | | + 4-----o--------o--o--|-----o--4 + | | | + 5-----o--------------o-----o--5 + v} *) + () + +let _ = + (* + blah blah + *) + () + +(* + * foo + * bar + *) + +(* + * foo + bar + *) + +let _ = + (* It is very confusing - same expression has two different types in two contexts:*) + (* 1. if passed as parameter it's RETURN_TYPE* since we are passing it as rvalue *) + (* 2. for return expression it's RETURN_TYPE since backend allows to treat it as lvalue*) + (* of RETURN_TYPE *) + (* Implications: *) + (* Fields: field_deref_trans relies on it - if exp has RETURN_TYPE then *) + (* it means that it's not lvalue in clang's AST (it'd be reference otherwise) *) + (* Methods: method_deref_trans actually wants a pointer to the object, which is*) + (* equivalent of value of ret_param. Since ret_exp has type RETURN_TYPE,*) + (* we optionally add pointer there to avoid backend confusion. *) + (* It works either way *) + (* Passing by value: may cause problems - there needs to be extra Sil.Load, but*) + (* doing so would create problems with methods. Passing structs by*) + (* value doesn't work good anyway. This may need to be revisited later*) + let x = y in + z + +let _ = + (* It is very confusing - same expression has two different types in two contexts: + * 1. if passed as parameter it's RETURN_TYPE* since we are passing it as rvalue + * 2. for return expression it's RETURN_TYPE since backend allows to treat it as lvalue + * of RETURN_TYPE + * Implications: + * Fields: field_deref_trans relies on it - if exp has RETURN_TYPE then + * it means that it's not lvalue in clang's AST (it'd be reference otherwise) + * Methods: method_deref_trans actually wants a pointer to the object, which is + * equivalent of value of ret_param. Since ret_exp has type RETURN_TYPE, + * we optionally add pointer there to avoid backend confusion. + * It works either way + * Passing by value: may cause problems - there needs to be extra Sil.Load, but + * doing so would create problems with methods. Passing structs by + * value doesn't work good anyway. This may need to be revisited later*) + let x = y in + z + +let _ = f (* foo + *) a + +(* 1 + * + 2 + * --- + * 3 + *) diff --git a/test/passing/refs.default/wrap_comments_break.ml.ref b/test/passing/refs.default/wrap_comments_break.ml.ref new file mode 100644 index 0000000000..0815464255 --- /dev/null +++ b/test/passing/refs.default/wrap_comments_break.ml.ref @@ -0,0 +1,8 @@ +let _ = + let _ = + fffffffffff + aaaaaaaaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbbbbbb + ~f:(fun x -> return xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx) + in + 2 diff --git a/test/passing/refs.default/wrap_invalid_doc_comments.ml.err b/test/passing/refs.default/wrap_invalid_doc_comments.ml.err new file mode 100644 index 0000000000..ee04b36da2 --- /dev/null +++ b/test/passing/refs.default/wrap_invalid_doc_comments.ml.err @@ -0,0 +1,6 @@ +Warning: Invalid documentation comment: +File "wrap_invalid_doc_comments.ml", line 2, characters 48-53: +'{v ... v}' (verbatim text) should begin on its own line. +Warning: Invalid documentation comment: +File "wrap_invalid_doc_comments.ml", line 2, characters 48-53: +'{v ... v}' (verbatim text) should not be empty. diff --git a/test/passing/refs.default/wrap_invalid_doc_comments.ml.ref b/test/passing/refs.default/wrap_invalid_doc_comments.ml.ref new file mode 100644 index 0000000000..5b38098d67 --- /dev/null +++ b/test/passing/refs.default/wrap_invalid_doc_comments.ml.ref @@ -0,0 +1,2 @@ +(** - Item 1 + - Item 2, that contains two block elements: {v v} *) diff --git a/test/passing/refs.default/wrapping_functor_args.ml.err b/test/passing/refs.default/wrapping_functor_args.ml.err new file mode 100644 index 0000000000..d5b0b1c7f4 --- /dev/null +++ b/test/passing/refs.default/wrapping_functor_args.ml.err @@ -0,0 +1 @@ +Warning: wrapping_functor_args.ml:25 exceeds the margin diff --git a/test/passing/refs.default/wrapping_functor_args.ml.ref b/test/passing/refs.default/wrapping_functor_args.ml.ref new file mode 100644 index 0000000000..86b0e237a8 --- /dev/null +++ b/test/passing/refs.default/wrapping_functor_args.ml.ref @@ -0,0 +1,44 @@ +(* This declaration looks odd *) +type request_token = + Sociaml_oauth_client.Client.Make(Sociaml_oauth_client.Posix.Clock) + (Sociaml_oauth_client.Posix.MAC_SHA1) + (Sociaml_oauth_client.Posix.Random) + .request_token + +(* Whereas this one works well *) +module OauthClient = + Sociaml_oauth_client.Client.Make + (Sociaml_oauth_client.Posix.Clock) + (Sociaml_oauth_client.Posix.MAC_SHA1) + (Sociaml_oauth_client.Posix.Random) + +module F1 + (G : functor (_ : T) -> T) + (A : sig + val x : int + end) = +struct end + +module F2 + (G : functor + (_ : T) + -> + T_________________________________________________________________________) + (A : sig + val x : int + end) = +struct end + +module F3 + (G : functor + (_ : T____________________________________________) + (_ : T____________________________________________) + -> T) + (A : sig + val x : int + end) = +struct end + +module F (* test *) (M : sig + type t +end) : S = struct end diff --git a/test/passing/refs.janestreet/.ocamlformat b/test/passing/refs.janestreet/.ocamlformat new file mode 100644 index 0000000000..3b217634ab --- /dev/null +++ b/test/passing/refs.janestreet/.ocamlformat @@ -0,0 +1 @@ +profile=janestreet diff --git a/test/passing/refs.janestreet/align_infix.ml.ref b/test/passing/refs.janestreet/align_infix.ml.ref new file mode 100644 index 0000000000..9d33b0072e --- /dev/null +++ b/test/passing/refs.janestreet/align_infix.ml.ref @@ -0,0 +1,3 @@ +let sum_of_squares num = + num + 1 |> List.range 0 |> List.map ~f:square |> List.fold_left ~init:0 ~f:( + ) +;; diff --git a/test/passing/refs.janestreet/alignment.ml.ref b/test/passing/refs.janestreet/alignment.ml.ref new file mode 100644 index 0000000000..4a9bf3d1bd --- /dev/null +++ b/test/passing/refs.janestreet/alignment.ml.ref @@ -0,0 +1,14 @@ +let file_contents = [] @ [ foo ] @ [ bar ] + +let _ = + match s.src with + | None -> [ zz ] + 2 + | Some s -> + [ Variable (s_src, OpamFormat.make_string (OpamFilename.to_string s)); yy ]; + foo + | Some s -> { fww = s_src, OpamFormat.make_string (OpamFilename.to_string s); gdd = yy } +;; + +let _ = [ x; y ] @ z +let _ = [ x; y ] @ z +let _ = [ x; y ] @ z diff --git a/test/passing/refs.janestreet/apply.ml.ref b/test/passing/refs.janestreet/apply.ml.ref new file mode 100644 index 0000000000..721b41ed59 --- /dev/null +++ b/test/passing/refs.janestreet/apply.ml.ref @@ -0,0 +1,98 @@ +let _ = List.map ~f:(( + ) (M.f x)) +let id x = x +let plus a ?(b = 0) c = a + b + c;; + +id (plus 1) ~b:1;; + +(* The version above does not type-check, while the version below does + type-check, and should not be formatted to the above. See + https://caml.inria.fr/mantis/view.php?id=7832 for explanation on the + type-checking (and dynamic semantics) distinction. *) + +(id (plus 1)) ~b:1 + +let ( !!! ) a ~b = a + b +let _ = ( !!! ) a b +let _ = ( !!! ) ~b +let _ = !!!!a b d +let _ = ( + ) a b c d + +let cartesian_product l1 l2 = + List.concat (l1 |> List.map (fun v1 -> l2 |> List.map (fun v2 -> v1, v2))) +;; + +let cartesian_product' long_list_one long_list_two = + List.concat + (long_list_one |> List.map (fun v1 -> long_list_two |> List.map (fun v2 -> v1, v2))) +;; + +let whatever a_function_name long_list_one some_other_thing = + List.map + (fun long_list_one_elt -> + do_something_with_a_function_and_some_things + a_function_name + long_list_one_elt + some_other_thing) + long_list_one +;; + +let whatever_labelled a_function_name long_list_one some_other_thing = + ListLabels.map long_list_one ~f:(fun long_list_one_elt -> + do_something_with_a_function_and_some_things + a_function_name + long_list_one_elt + some_other_thing) +;; + +[@@@ocamlformat "indicate-multiline-delimiters=closing-on-separate-line"] + +let cartesian_product' long_list_one long_list_two = + List.concat + (long_list_one |> List.map (fun v1 -> long_list_two |> List.map (fun v2 -> v1, v2))) +;; + +let whatever a_function_name long_list_one some_other_thing = + List.map + (fun long_list_one_elt -> + do_something_with_a_function_and_some_things + a_function_name + long_list_one_elt + some_other_thing + ) + long_list_one +;; + +let whatever_labelled a_function_name long_list_one some_other_thing = + ListLabels.map long_list_one ~f:(fun long_list_one_elt -> + do_something_with_a_function_and_some_things + a_function_name + long_list_one_elt + some_other_thing + ) +;; + +(a - b) ();; +((a - b) [@foo]) () + +let _ = M.(loooooooooooooooooooooong + loooooooooooooooooong) + +let _ = + M.( + loooooooooooooooooooooong + + loooooooooooooooooong + + llllllllllloooooooooooooooooonnnnnnnnnnnnnggggggggggg + ) +;; + +let _ = + i'm_a_function + loooooooooooong + (loooooooooooong + looooooooooooooong + loooooooooooooong + [ loooooooooong; loooooooooooong; loooooooooooooooooooooong ] + ) +;; + +let f (x :: y) = x +let f (* xx *) ((* aa *) x (* bb *) :: (* cc *) y (* dd *)) (* yy *) = x diff --git a/test/passing/refs.janestreet/apply_functor.ml.err b/test/passing/refs.janestreet/apply_functor.ml.err new file mode 100644 index 0000000000..74342934dd --- /dev/null +++ b/test/passing/refs.janestreet/apply_functor.ml.err @@ -0,0 +1 @@ +Warning: apply_functor.ml:1 exceeds the margin diff --git a/test/passing/refs.janestreet/apply_functor.ml.ref b/test/passing/refs.janestreet/apply_functor.ml.ref new file mode 100644 index 0000000000..6fbcf5f8fe --- /dev/null +++ b/test/passing/refs.janestreet/apply_functor.ml.ref @@ -0,0 +1,2 @@ +module _ = F (functor (X : T) -> X) +module _ = F (functor (X____________________________ : T) -> X____________________________) diff --git a/test/passing/refs.janestreet/args_grouped.ml.ref b/test/passing/refs.janestreet/args_grouped.ml.ref new file mode 100644 index 0000000000..bd7429b535 --- /dev/null +++ b/test/passing/refs.janestreet/args_grouped.ml.ref @@ -0,0 +1,113 @@ +let nullsafe_optimistic_third_party_params_in_non_strict = + CLOpt.mk_bool + ~long:"nullsafe-optimistic-third-party-params-in-non-strict" + (* Turned on for compatibility reasons. Historically this is because + there was no actionable way to change third party annotations. Now + that we have such a support, this behavior should be reconsidered, + provided our tooling and error reporting is friendly enough to be + smoothly used by developers. *) + ~default:true + "Nullsafe: in this mode we treat non annotated third party method params as if they were \ + annotated as nullable." +;; + +let test_file_renamings_from_json = + let create_test test_input expected_output _ = + let test_output input = + DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.from_json input + in + foo + in + fooooooooooooooo +;; + +let eval location exp0 astate = + let rec eval exp astate = + match (exp : Exp.t) with + | Var id -> Ok (eval_var (* error in case of missing history? *) [] (Var.of_id id) astate) + | Lvar pvar -> + Ok (eval_var [ ValueHistory.VariableAccessed (pvar, location) ] (Var.of_pvar pvar) astate) + | Lfield (exp', field, _) -> goooooooo + in + fooooooooooooooooooooo +;; + +let declare_locals_and_ret tenv pdesc (prop_ : Prop.normal Prop.t) = + let foooooooooooooo = + BiabductionConfig.run_in_re_execution_mode + (* no footprint vars for locals *) + sigma_locals_and_ret + () + in + fooooooooooooooooooooooooooo +;; + +let bottom_up fooooooooooo = + let empty = Int.equal 0 !scheduled && Queue.is_empty pending in + if empty + then ( + remaining := 0; + L.progress + "Finished call graph scheduling, %d procs remaining (in, or reaching, cycles).@." + (CallGraph.n_procs syntactic_call_graph); + if Config.debug_level_analysis > 0 then CallGraph.to_dotty syntactic_call_graph "cycles.dot"; + foooooooooooooooooo) + else fooooooooooooooooo +;; + +let test_file_renamings_from_json = + let fooooooooooooo = + match expected_output with + | Return exp -> + assert_equal + ~pp_diff + ~cmp:DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.equal + exp + (test_output test_input) + | Raise exc -> assert_raises exc (fun () -> test_output test_input) + in + foooooooooooooooo +;; + +let gen_with_record_deps ~expand t resolved_forms ~dep_kind = + let foooooooooooooooooooooo = + expand + (* we keep the dir constant here to replicate the old behavior of: + (chdir foo %{exe:bar}). This should lookup ./bar rather than + ./foo/bar *) + resolved_forms + ~dir:t.dir + ~dep_kind + ~expand_var:t.expand_var + in + { t with expand_var } +;; + +let f = + very_long_function_name + ~very_long_variable_name:(very_long expression) + (* this is a + multiple-line-spanning + comment *) + ~y +;; + +let eradicate_meta_class_is_nullsafe = + register + ~id:"ERADICATE_META_CLASS_IS_NULLSAFE" + ~hum:"Class is marked @Nullsafe and has 0 issues" + (* Should be enabled for special integrations *) + ~enabled:false + Info + Eradicate (* TODO *) + ~user_documentation:"" +;; + +let eradicate_meta_class_is_nullsafe = + register + ~id:"ERADICATE_META_CLASS_IS_NULLSAFE" (* Should be enabled for special integrations *) + ~hum:"Class is marked @Nullsafe and has 0 issues" + (* Should be enabled for special integrations *) + ~enabled:false + Info +;; diff --git a/test/passing/refs.janestreet/array.ml.ref b/test/passing/refs.janestreet/array.ml.ref new file mode 100644 index 0000000000..c4cdd7a529 --- /dev/null +++ b/test/passing/refs.janestreet/array.ml.ref @@ -0,0 +1,41 @@ +[| 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 +|] + +let f = function + | [| 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + |] -> () +;; diff --git a/test/passing/refs.janestreet/assignment_operator-op_begin_line.ml.ref b/test/passing/refs.janestreet/assignment_operator-op_begin_line.ml.ref new file mode 100644 index 0000000000..ae0dc79ea2 --- /dev/null +++ b/test/passing/refs.janestreet/assignment_operator-op_begin_line.ml.ref @@ -0,0 +1,58 @@ +let foo = + entry.logdata.value_end := entry.logdata.value_end - !remove_size + testtesttest; + entry.logdata.value_end + := (entry.logdata.value_end - !remove_size + testtesttest) [@foo]; + (* foooooooooo *) + entry.logdata.value_end + := (entry.logdata.value_end - !remove_size + testtesttest) [@foo] + (* foooooooooooo *); + entry.logdata.value_end := entry.logdata.value_end - !remove_size + testtesttest + (* fooooooooooooooooooooooooo *); + value_end := entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest; + value_end + := (entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest) [@foo]; + value_end + := (entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest) [@foo] + (* fooooooooooooo *); + (* foooooooooooooooooooo *) + value_end := entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest + (* foooooooo *); + foo +;; + +let _ = r (* _________________________________________________________________ *) := 1 + +let _ = + r + (* _________________________________________________________________ *) + (* _________________________________________________________________ *) := 1 +;; + +let _ = r := (* _________________________________________________________________ *) 1 + +let _ = + r + := (* _________________________________________________________________ *) + (* _________________________________________________________________ *) + 1 +;; + +let _ = + r (* _________________________________________________________________ *) + := (* _________________________________________________________________ *) 1 +;; + +let _ = + r + (* _________________________________________________________________ *) + (* _________________________________________________________________ *) + := (* _________________________________________________________________ *) + (* _________________________________________________________________ *) + 1 +;; + +let _ = + aaaaaaa + (* __________________________________________________________________________________ *) + := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +;; diff --git a/test/passing/refs.janestreet/assignment_operator.ml.ref b/test/passing/refs.janestreet/assignment_operator.ml.ref new file mode 100644 index 0000000000..ae0dc79ea2 --- /dev/null +++ b/test/passing/refs.janestreet/assignment_operator.ml.ref @@ -0,0 +1,58 @@ +let foo = + entry.logdata.value_end := entry.logdata.value_end - !remove_size + testtesttest; + entry.logdata.value_end + := (entry.logdata.value_end - !remove_size + testtesttest) [@foo]; + (* foooooooooo *) + entry.logdata.value_end + := (entry.logdata.value_end - !remove_size + testtesttest) [@foo] + (* foooooooooooo *); + entry.logdata.value_end := entry.logdata.value_end - !remove_size + testtesttest + (* fooooooooooooooooooooooooo *); + value_end := entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest; + value_end + := (entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest) [@foo]; + value_end + := (entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest) [@foo] + (* fooooooooooooo *); + (* foooooooooooooooooooo *) + value_end := entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest + (* foooooooo *); + foo +;; + +let _ = r (* _________________________________________________________________ *) := 1 + +let _ = + r + (* _________________________________________________________________ *) + (* _________________________________________________________________ *) := 1 +;; + +let _ = r := (* _________________________________________________________________ *) 1 + +let _ = + r + := (* _________________________________________________________________ *) + (* _________________________________________________________________ *) + 1 +;; + +let _ = + r (* _________________________________________________________________ *) + := (* _________________________________________________________________ *) 1 +;; + +let _ = + r + (* _________________________________________________________________ *) + (* _________________________________________________________________ *) + := (* _________________________________________________________________ *) + (* _________________________________________________________________ *) + 1 +;; + +let _ = + aaaaaaa + (* __________________________________________________________________________________ *) + := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +;; diff --git a/test/passing/refs.janestreet/attribute_and_expression.ml.ref b/test/passing/refs.janestreet/attribute_and_expression.ml.ref new file mode 100644 index 0000000000..274ec92477 --- /dev/null +++ b/test/passing/refs.janestreet/attribute_and_expression.ml.ref @@ -0,0 +1,7 @@ +let _ = f (2 [@test 2]) +let tail1 = [ 1; 2 ] [@hello] +let tail2 = 0 :: ([ 1; 2 ] [@hello]) +let tail3 = 0 :: ([] [@hello]) +let _ = ("%d" : _ format) [@p] +let _ = (`B `N : p2) [@p] +let _ = (`So (`Se (`So `O)) : podd) [@p] diff --git a/test/passing/refs.janestreet/attributes.ml.err b/test/passing/refs.janestreet/attributes.ml.err new file mode 100644 index 0000000000..133bf9c6b1 --- /dev/null +++ b/test/passing/refs.janestreet/attributes.ml.err @@ -0,0 +1 @@ +Warning: attributes.ml:257 exceeds the margin diff --git a/test/passing/refs.janestreet/attributes.ml.ref b/test/passing/refs.janestreet/attributes.ml.ref new file mode 100644 index 0000000000..0a93bed930 --- /dev/null +++ b/test/passing/refs.janestreet/attributes.ml.ref @@ -0,0 +1,467 @@ +[%foo type[@foo] t = < .. > ] + +let _ = + (function[@warning "-4"] + | None -> true + | _ -> false) + None +;; + +let f (x [@warning ""]) = () +let v = (fun [@inline] x -> x) 1 + +external f : (float[@unboxed]) -> int = "blah" [@@noalloc] +val x : ?x:unit (** not dropped *) -> unit + +type t = + { a : int + ; b : int [@default 1] [@drop_if] + ; c : int [@default 1] [@drop_if] (** docstring that is long enough to break *) + } + +type t = + { a : int + ; b : someloooooooooooooooooooooooooooooong typ + [@default looooooooooooooooooooooooooooooooooooooooong] [@drop_if somethingelse] + ; b : somelong typ [@default 1] + ; c : someloooooooooooooooooooooooooooooong typ + [@default looooooooooooooooooooooooooooooooooooooooong] [@drop_if somethingelse] + (** docstring that is long enough to break *) + } + +val foo : int [@@deprecated "it is good the salad"] [@@warning "-32"] [@@warning "-99"] + +val foo : int +[@@deprecated "it is good the salad"] +[@@warning "-32"] +[@@warning "-99"] +[@@some long comment] + +type t = + | A of int [@attr] + | B of (float[@attr]) + | C [@attr] + +type t = + [ `A of int [@attr] + | `B of (float[@attr]) + | `C [@attr] + ] + +let[@inline always] f x = + let[@something] e = 1 in + e +;; + +module type M = S [@test1] + +module type M = sig + module T (T : sig end) : (S with type t = r [@test2]) + module T (S : S [@test]) : S + module T : (S with type t = (r[@test3]) [@test4]) + + module T : + (S with type t = t and type u := u and module R = R and module S := S [@test]) + + module T : module type of X [@test5] + module T : (module type of X) [@test6] + module T : [%ext] [@test7] + module T = T [@@test8] + module [@test8] T = T +end + +let f = fun [@inline] [@inline never] x -> x +let g = fun [@inline] [@something_else] [@ocaml.inline] x -> x +let h x = (g [@inlined] [@ocaml.inlined never]) x +let v = (fun [@inline] [@inlined] x -> x) 1 +let[@inline] i = fun [@inline] x -> x;; + +if [@test] true then () else ();; +if [@test] true then () else if [@test] true then () else () + +let _ = (A [@test]), (() [@test]), ([] [@test]), [||] [@test] + +type blocklist = + { f1 : int [@version 1, 1, 0] (** short comment *) + ; f2 : (int64 * int64) list + (** loooooooooooooooooooooooooooooong + commmmmmmmmmmmmmmmmmmmmmmmmmmmmmmment *) + } + +type blocklist = + | F1 of int [@version 1, 1, 0] (** short comment *) + | F2 : int -> blocklist [@version 1, 1, 0] (** short comment *) + | F3 of (int64 * int64) list + (** loooooooooooooooooooooooooooooong + commmmmmmmmmmmmmmmmmmmmmmmmmmmmmmment *) + +type u = + | C of int * int + [@doc + [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit. " + ; "Etiam vel mauris fermentum, condimentum quam a, porta nisi" + ]] +[@@deriving something] [@@doc [ "Ut at dolor a eros venenatis maximus ut at nisi." ]] + +let ((A, B) [@test]) = () +let ((lazy a) [@test]) = () +let ((exception a) [@test]) = () +let ((B x) [@test]) = () +let ((`B x) [@test]) = () +let (B [@test]) = () +let (`B [@test]) = () +let (B.(A) [@test]) = () +let ('x' .. 'z' [@test]) = () +let (#test [@test]) = () +let ((module X) [@test]) = () +let (a [@test]) = () +let (_ [@test]) = () +let ("" [@test]) = () +let _ = f x ~f:(fun [@test] x -> x) +let _ = f x ~f:(function [@test] x -> x) + +let _ = + f x ~f:(function [@test] + | X -> x + | X -> x) +;; + +let () = () +and[@warning "-32"] f = () + +external x : a -> b -> (a -> b[@test]) = "" + +let f = fun [@test] x y -> () +let f y = fun [@test] y -> () +let (f [@test]) = fun y -> fun [@test] y -> () + +module type T = sig + class subst : ((ident -> ident)[@attr]) -> (ident -> ident) -> object + inherit mapper + end[@attr] +end + +let _ = fun [@inlined always] x y -> z +let () = assert ((assert false [@imp Show]) 1.0 = "1.") +let () = f (assert false) + +let _ = + match x with + | A -> + [%expr + match y with + | e -> e] +;; + +let _ = + match x with + | A -> + [%expr + match y with + | e -> + (match e with + | x -> x)] +;; + +type t = { a : int } +[@@deriving xxxxxxxxxxxxxxxxxxxxxxxxxxx] +(* comment *) +[@@deriving xxxxxxxxxxxxxxxxxxxxxxxxxxx] + +module type A = sig + module A := A.B [@@attr] +end + +module M = struct + type t + [@@immediate] + (* ______________________________________ *) + [@@deriving variants, sexp_of] +end + +let _ = {<>} [@a] +let _ = f ({<>} [@a]) +let _ = {<x = 1>} [@a] +let _ = f ({<x = 1>} [@a]) +let _ = (x :> t) [@a] +let _ = f ((x :> t) [@a]) +let _ = (module M) [@a] +let _ = f ((module M) [@a]) +let _ = (module M : S) [@a] +let _ = f ((module M : S) [@a]) +let _ = ([] @ []) [@a] + +(* Infix operator should left-align with the inner parens *) +let _ = + f + ((a_____________________________________ @ b_____________________________________) + [@a]) +;; + +(* Attribute should wrap as a block *) +let _ = + (a_______________________________________________________________________ + @ b________________________________________________________________) + [@a] +;; + +let _ = + (a_________________________________________________________________ + @ b_________________________________________________________________) + [@a] +;; + +let _ = f (([] @ []) [@a]) +let _ = ("" ^ "") [@a] +let _ = f (("" ^ "") [@a]) +let _ = (0 + 0) [@a] +let _ = f ((0 + 0) [@a]) +let _ = (a.x <- 1) [@a] +let _ = f ((a.x <- 1) [@a]) +let _ = (f @@ a) [@attr] +let _ = f ((f @@ a) [@attr]) +let _ = f 1 ([ e; f ] [@a]) +let _ = f 1 ([| e; f |] [@a]) + +let _ = + object + method g = (a <- b) [@a] + method h = f ((a <- b) [@a]) + + method i = + (a <- b) [@a]; + () + end +;; + +let _ = a.(b) [@a] +let _ = f (a.(b) [@a]) +let _ = (a.*?!@{b} <- c) [@a] +let _ = f ((a.*?!@{b} <- c) [@a]);; + +(* Regression tests for https://github.com/ocaml-ppx/ocamlformat/issues/1256 + (dropped parentheses around tuples with attributes). *) + +(0, 0) [@a] + +let _ = (0, 0) [@a] +let _ = f ((0, 0) [@a]);; + +(* Ensure that adding an attribute doesn't break left-alignment of tuple + components *) + +(a________________________________________, b________________________________________) +[@a] + +let _ = + f + ((a________________________________________, b________________________________________) + [@a]) +;; + +let _ = + a [@a]; + b +;; + +let _ = + f + (a [@a]; + b) +;; + +let _ = + a; + b [@a] +;; + +let _ = + f + (a; + b [@a]) +;; + +let _ = + (a; + b) + [@a] +;; + +let _ = + f + ((a; + b) + [@a]) +;; + +let _ = + a; + b [@a]; + c +;; + +let _ = + a; + (b1; + b2) + [@a] +;; + +let _ = + a; + (b1; + b2) + [@a]; + c +;; + +(* Ensure that adding an attribute doesn't break left-alignment of sequenced + expressions *) +let _ = + (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb) + [@a] +;; + +[@@@a (**b*)] + +let (Foo ((A | B) [@attr])) = () +let ([ (A | B) [@attr]; b; c ] [@attr]) = () +let ([| a; (A | B) [@attr]; c |] [@attr]) = () +let { b = (A | B) [@attr] } = () +let (`Foo ((`A | `B) [@attr])) = () +let (A | B) [@attr], (A | B) [@attr] = () +let (A | B) [@attr] = () +let (Foo ((A | B) [@attr]) : (t[@attr])) = () +let (M.(A | B) [@attr]) = ();; + +(a_______________________________________________________________________________ [@attr]) + () +;; + +(a_______________________________________, b____________________________________) [@attr] +;; +{ a____________________________________ = b___________________________________ } [@attr] + +let _ = + (match[@ocaml.warning "-4"] bar with + | _ -> ()); + foo +;; + +let _ = + (try[@ocaml.warning "-4"] bar with + | _ -> ()); + foo +;; + +let pp f ({ cf_interface; cf_is_objc_block; cf_virtual } [@warning "+9"]) = () + +let pp f ({ cf_assign_last_arg; cf_injected_destructor; cf_interface } [@warning "+9"]) = + () +;; + +let pp + f + ({ cf_assign_last_arg; cf_injected_destructor; cf_interface; cf_is_objc_block } + [@warning "+9"]) + = + () +;; + +let _ = f ((* comments *) "c" [@attributes]) +let _ = f ((* comments *) 'c' [@attributes]) + +let _ = function + | ("foo" [@attr]) -> ("bar" [@attr2]) +;; + +let _ = function + | ('A' [@attr]) -> ('B' [@attr2]) + | ('A' .. 'B' [@attr2]) -> () +;; + +let _ = + match x with + | _ + when f + ~f: + (function [@ocaml.warning (* ....................................... *) "-4"] + | _ -> .) -> y +;; + +let[@a + (* .............................................. + ........................... .......................... + ...................... *) + foo + (* ....................... *) + (* ................................. *) + (* ...................... *)] _ + = + match[@ocaml.warning (* ....................................... *) "-4"] + x [@attr (* .......................... .................. *) some_attr] + with + | _ + when f + ~f:(function[@ocaml.warning (* ....................................... *) "-4"] + | _ -> .) + ~f: + (function[@ocaml.warning + (* ....................................... *) + (* ....................................... *) + "foooooooooooooooooooooooooooo \ + fooooooooooooooooooooooooooooooooooooo"] + | _ -> .) + ~f: + (function[@ocaml.warning + (* ....................................... *) + let x = a + and y = b in + x + y] _ -> .) -> + y + [@attr + (* ... *) + (* ... *) + attr (* ... *)] +;; + +let raise_length_mismatch name n1 n2 = + invalid_argf "length mismatch in %s: %d <> %d" name n1 n2 () +[@@cold] [@@inline never] [@@local never] [@@specialise never] +;; + +external unsafe_memset : t -> pos:int -> len:int -> char -> unit = "bigstring_memset_stub" +[@@noalloc] + +let _ = f ((1 : int) [@a]) +let _ = f ((1 : int) [@a]) ((1 : int) [@a]) +let _ = f ((((1 : int) [@a]) : (int[@b])) [@a]) ((1 : int) [@a]) + +include [@foo] M [@boo] + +let () = + let () = + S.ntyp Cbor_type.Reserved + @@ S.tok + begin [@warning "-4"] + fun ev -> + match ev with + | Cbor_event.Reserved int -> Some int + | _ -> None + end + in + () +;; + +let () = + let () = + S.ntyp Cbor_type.Reserved + @@ (S.tok (fun ev -> + match ev with + | Cbor_event.Reserved int -> Some int + | _ -> None) + [@warning "-4"]) + in + () +;; diff --git a/test/passing/refs.janestreet/attributes.mli.ref b/test/passing/refs.janestreet/attributes.mli.ref new file mode 100644 index 0000000000..89e458bb4c --- /dev/null +++ b/test/passing/refs.janestreet/attributes.mli.ref @@ -0,0 +1,6 @@ +[@@@ocaml.doc "_"] + +val f : int -> int -> int [@@cold] [@@inline never] [@@local never] [@@specialise never] + +external unsafe_memset : t -> pos:int -> len:int -> char -> unit = "bigstring_memset_stub" +[@@noalloc] diff --git a/test/passing/refs.janestreet/binders.ml.ref b/test/passing/refs.janestreet/binders.ml.ref new file mode 100644 index 0000000000..00abb48b9f --- /dev/null +++ b/test/passing/refs.janestreet/binders.ml.ref @@ -0,0 +1,14 @@ +external f : 'a -> 'a = "asdf" + +external g + : 'aaaaaaa 'aaaaaaaaaaaaaaa 'aaaaaaaaaaaaaaaaaaaaaa 'aaaaaaaaaaaaaa 'aaaaaaa + 'fooooo_foooooo. + 'a -> 'a -> 'a + = "asdf" + +type f = Foo : 'a -> t +type f = Foo : 'a -> 'a +type g = Foo : 'a. 'a -> t + +type g = + | Foo : 'aaaaaaaaaaa 'bbbbbbbbbbbbbb 'ccccccccccccccc 'fooooo_fooooooo. 'foo -> 'b diff --git a/test/passing/refs.janestreet/break_before_in-auto.ml.ref b/test/passing/refs.janestreet/break_before_in-auto.ml.ref new file mode 100644 index 0000000000..e08326bf18 --- /dev/null +++ b/test/passing/refs.janestreet/break_before_in-auto.ml.ref @@ -0,0 +1,130 @@ +let flat : unit = + let short = 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let fooo = 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let baaar = 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let long = 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let longer = + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let longeerer = + 11 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let longest = + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 in + let violate_margin = + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 in + let violate_margin = + 1 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 in + let violate_margin = + 1 + 11 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 in + let violate_margin = + 1 + 111 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 in + () +;; + +let nested : unit = + let short = + let fooo = + let baaar = + let long = + let longer = + let longeerer = + let violate_margin = + let longest = + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 in + longest + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1111 + + 1 in + violate_margin + + 11 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 in + longeerer + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 in + longer + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + long + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + baaar + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + fooo + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + () +;; diff --git a/test/passing/refs.janestreet/break_before_in.ml.ref b/test/passing/refs.janestreet/break_before_in.ml.ref new file mode 100644 index 0000000000..a08b442e40 --- /dev/null +++ b/test/passing/refs.janestreet/break_before_in.ml.ref @@ -0,0 +1,145 @@ +let flat : unit = + let short = 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let fooo = 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let baaar = 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let long = 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let longer = + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + let longeerer = + 11 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + let longest = + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + in + let violate_margin = + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in + let violate_margin = + 1 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in + let violate_margin = + 1 + 11 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in + let violate_margin = + 1 + 111 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in + () +;; + +let nested : unit = + let short = + let fooo = + let baaar = + let long = + let longer = + let longeerer = + let violate_margin = + let longest = + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + + 11 + in + longest + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1111 + + 1 + in + violate_margin + + 11 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + in + longeerer + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + + 1 + in + longer + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + long + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + baaar + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + fooo + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + () +;; diff --git a/test/passing/refs.janestreet/break_cases-align.ml.err b/test/passing/refs.janestreet/break_cases-align.ml.err new file mode 100644 index 0000000000..2d7752d744 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-align.ml.err @@ -0,0 +1 @@ +Warning: break_cases-align.ml:280 exceeds the margin diff --git a/test/passing/refs.janestreet/break_cases-align.ml.ref b/test/passing/refs.janestreet/break_cases-align.ml.ref new file mode 100644 index 0000000000..1cc5558a10 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-align.ml.ref @@ -0,0 +1,343 @@ +let f x = function + | C + | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) + | A + | K -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () +;; + +let f = + let g = function + | H when x y <> k -> 2 + | T + | P + | U -> + 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + match y with + | O -> 5 + | P when h x -> + (function + | A -> 6) +;; + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + match y with + | O -> 5 + | P when h x -> + (function + | A -> 6)); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + (match k with + | foooo -> foooooooo); + fooooooooooooooo fooooooooooooo) +;; + +match x with +| true -> + (match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy when fffffffffffffff bbbbbbbbbb yyyyyyyyyy + -> + () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> + match y with + | Some _ -> true + | None -> false + in + () +;; + +let () = + match fooooo with + | x -> x +;; + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _) + , Const (Cfun callee_pname) + , (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _ + , loc + , _ ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc +;; + +let mod_int c1 c2 is_safe dbg = + match c1, c2 with + | c1, Cconst_int (0, _) -> Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x + | -1 -> + () +;; + +let merge_columns l old_table = + let rec aux = function + | [] + | [ None ] -> + [], [] + in + foooooooooooooooooooooooooo fooooooooooooooooooooo +;; + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a +;; + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo +;; + +let () = + match v with + | None -> None + | Some x -> + match x with + | None -> None + | Some x -> + match x with + | None -> None + | Some x -> x +;; + +let _ = function + | (exception A) + | B -> + 1 + | C -> 2 +;; + +let _ = function + | A + | (exception B) -> + 1 + | C -> 2 +;; + +let _ = + match x with + | (exception A) + | (exception B) -> + 1 + | C -> 2 +;; + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo) +;; + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> () + end +;; + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () +;; + +let _ = + match x with + | { y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ) + } -> + () +;; + +let _ = + match x with + | { y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ) + } -> + () +;; + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo +;; + +let get_nullability = function + | ArrayAccess + | OptimisticFallback (* non-null is the most optimistic type *) + | Undef (* This is a very special case, assigning non-null is a technical trick *) -> + Nullability.Nonnull +;; + +let _ = + try () with + | _ -> + match () with + | _ -> () +;; + +let _ = + let _ = + try () with + | _ -> + try () with + | _ -> () + in + () +;; + +let _ = function + | _ -> + x + >>= (function + | `Halt -> return x) + | _ -> () +;; + +let _ = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x) + | _ -> () + in + () +;; + +class c = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x) + | _ -> () + in + object end diff --git a/test/passing/refs.janestreet/break_cases-all.ml.err b/test/passing/refs.janestreet/break_cases-all.ml.err new file mode 100644 index 0000000000..5838e615f2 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-all.ml.err @@ -0,0 +1 @@ +Warning: break_cases-all.ml:280 exceeds the margin diff --git a/test/passing/refs.janestreet/break_cases-all.ml.ref b/test/passing/refs.janestreet/break_cases-all.ml.ref new file mode 100644 index 0000000000..8ee47e0864 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-all.ml.ref @@ -0,0 +1,343 @@ +let f x = function + | C + | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) + | A + | K -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () +;; + +let f = + let g = function + | H when x y <> k -> 2 + | T + | P + | U -> + 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + (match y with + | O -> 5 + | P when h x -> + (function + | A -> 6)) +;; + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + (match y with + | O -> 5 + | P when h x -> + (function + | A -> 6))); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + (match k with + | foooo -> foooooooo); + fooooooooooooooo fooooooooooooo) +;; + +match x with +| true -> + (match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy when fffffffffffffff bbbbbbbbbb yyyyyyyyyy + -> + () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> + (match y with + | Some _ -> true + | None -> false) + in + () +;; + +let () = + match fooooo with + | x -> x +;; + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _) + , Const (Cfun callee_pname) + , (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _ + , loc + , _ ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc +;; + +let mod_int c1 c2 is_safe dbg = + match c1, c2 with + | c1, Cconst_int (0, _) -> Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x + | -1 -> + () +;; + +let merge_columns l old_table = + let rec aux = function + | [] + | [ None ] -> + [], [] + in + foooooooooooooooooooooooooo fooooooooooooooooooooo +;; + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a +;; + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo +;; + +let () = + match v with + | None -> None + | Some x -> + (match x with + | None -> None + | Some x -> + (match x with + | None -> None + | Some x -> x)) +;; + +let _ = function + | (exception A) + | B -> + 1 + | C -> 2 +;; + +let _ = function + | A + | (exception B) -> + 1 + | C -> 2 +;; + +let _ = + match x with + | (exception A) + | (exception B) -> + 1 + | C -> 2 +;; + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo) +;; + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> () + end +;; + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () +;; + +let _ = + match x with + | { y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ) + } -> + () +;; + +let _ = + match x with + | { y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ) + } -> + () +;; + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo +;; + +let get_nullability = function + | ArrayAccess + | OptimisticFallback (* non-null is the most optimistic type *) + | Undef (* This is a very special case, assigning non-null is a technical trick *) -> + Nullability.Nonnull +;; + +let _ = + try () with + | _ -> + (match () with + | _ -> ()) +;; + +let _ = + let _ = + try () with + | _ -> + (try () with + | _ -> ()) + in + () +;; + +let _ = function + | _ -> + x + >>= (function + | `Halt -> return x) + | _ -> () +;; + +let _ = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x) + | _ -> () + in + () +;; + +class c = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x) + | _ -> () + in + object end diff --git a/test/passing/refs.janestreet/break_cases-closing_on_separate_line.ml.err b/test/passing/refs.janestreet/break_cases-closing_on_separate_line.ml.err new file mode 100644 index 0000000000..2174dfb435 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-closing_on_separate_line.ml.err @@ -0,0 +1 @@ +Warning: break_cases-closing_on_separate_line.ml:293 exceeds the margin diff --git a/test/passing/refs.janestreet/break_cases-closing_on_separate_line.ml.ref b/test/passing/refs.janestreet/break_cases-closing_on_separate_line.ml.ref new file mode 100644 index 0000000000..971aeca6d4 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-closing_on_separate_line.ml.ref @@ -0,0 +1,361 @@ +let f x = function + | C + | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) + | A + | K -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () +;; + +let f = + let g = function + | H when x y <> k -> 2 + | T + | P + | U -> + 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + ( match y with + | O -> 5 + | P when h x -> + (function + | A -> 6 + ) + ) +;; + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + ( match y with + | O -> 5 + | P when h x -> + (function + | A -> 6 + ) + ) + ); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + ( match k with + | foooo -> foooooooo + ); + fooooooooooooooo fooooooooooooo + ) +;; + +match x with +| true -> + ( match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" + ) +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy when fffffffffffffff bbbbbbbbbb yyyyyyyyyy + -> + () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> + ( match y with + | Some _ -> true + | None -> false + ) + in + () +;; + +let () = + match fooooo with + | x -> x +;; + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _) + , Const (Cfun callee_pname) + , (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _ + , loc + , _ + ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc +;; + +let mod_int c1 c2 is_safe dbg = + match c1, c2 with + | c1, Cconst_int (0, _) -> Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x + | -1 -> + () +;; + +let merge_columns l old_table = + let rec aux = function + | [] + | [ None ] -> + [], [] + in + foooooooooooooooooooooooooo fooooooooooooooooooooo +;; + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a +;; + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo +;; + +let () = + match v with + | None -> None + | Some x -> + ( match x with + | None -> None + | Some x -> + ( match x with + | None -> None + | Some x -> x + ) + ) +;; + +let _ = function + | (exception A) + | B -> + 1 + | C -> 2 +;; + +let _ = function + | A + | (exception B) -> + 1 + | C -> 2 +;; + +let _ = + match x with + | (exception A) + | (exception B) -> + 1 + | C -> 2 +;; + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + ) +;; + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> () + end +;; + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () +;; + +let _ = + match x with + | { y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ) + } -> + () +;; + +let _ = + match x with + | { y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ) + } -> + () +;; + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo +;; + +let get_nullability = function + | ArrayAccess + | OptimisticFallback (* non-null is the most optimistic type *) + | Undef (* This is a very special case, assigning non-null is a technical trick *) -> + Nullability.Nonnull +;; + +let _ = + try () with + | _ -> + ( match () with + | _ -> () + ) +;; + +let _ = + let _ = + try () with + | _ -> + ( try () with + | _ -> () + ) + in + () +;; + +let _ = function + | _ -> + x + >>= (function + | `Halt -> return x + ) + | _ -> () +;; + +let _ = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x + ) + | _ -> () + in + () +;; + +class c = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x + ) + | _ -> () + in + object end diff --git a/test/passing/refs.janestreet/break_cases-closing_on_separate_line_fit_or_vertical.ml.err b/test/passing/refs.janestreet/break_cases-closing_on_separate_line_fit_or_vertical.ml.err new file mode 100644 index 0000000000..04e223e95a --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-closing_on_separate_line_fit_or_vertical.ml.err @@ -0,0 +1 @@ +Warning: break_cases-closing_on_separate_line_fit_or_vertical.ml:255 exceeds the margin diff --git a/test/passing/refs.janestreet/break_cases-closing_on_separate_line_fit_or_vertical.ml.ref b/test/passing/refs.janestreet/break_cases-closing_on_separate_line_fit_or_vertical.ml.ref new file mode 100644 index 0000000000..d33ab01d6c --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-closing_on_separate_line_fit_or_vertical.ml.ref @@ -0,0 +1,322 @@ +let f x = function + | C | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) | A | K -> 1 + | D -> + let a = "this" in + let b = "breaks" in + () +;; + +let f = + let g = function + | H when x y <> k -> 2 + | T | P | U -> 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z | P | M -> + ( match y with + | O -> 5 + | P when h x -> + (function + | A -> 6 + ) + ) +;; + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z | P | M -> + ( match y with + | O -> 5 + | P when h x -> + (function + | A -> 6 + ) + ) + ); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + ( match k with + | foooo -> foooooooo + ); + fooooooooooooooo fooooooooooooo + ) +;; + +match x with +| true -> + ( match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" + ) +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy when fffffffffffffff bbbbbbbbbb yyyyyyyyyy + -> () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> + ( match y with + | Some _ -> true + | None -> false + ) + in + () +;; + +let () = + match fooooo with + | x -> x +;; + +let () = + match foooo with + | x | x | x -> x + | y | foooooooooo | fooooooooo -> y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _) + , Const (Cfun callee_pname) + , (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _ + , loc + , _ + ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc +;; + +let mod_int c1 c2 is_safe dbg = + match c1, c2 with + | c1, Cconst_int (0, _) -> Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x | -1 -> () +;; + +let merge_columns l old_table = + let rec aux = function + | [] | [ None ] -> [], [] + in + foooooooooooooooooooooooooo fooooooooooooooooooooo +;; + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let () = + match foooo with + | x | x | x -> x + | y | foooooooooo | fooooooooo -> y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a +;; + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo +;; + +let () = + match v with + | None -> None + | Some x -> + ( match x with + | None -> None + | Some x -> + ( match x with + | None -> None + | Some x -> x + ) + ) +;; + +let _ = function + | (exception A) | B -> 1 + | C -> 2 +;; + +let _ = function + | A | (exception B) -> 1 + | C -> 2 +;; + +let _ = + match x with + | (exception A) | (exception B) -> 1 + | C -> 2 +;; + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + ) +;; + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> Errors.isset_in_strict p + | _ -> () + end +;; + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> () +;; + +let _ = + match x with + | { y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ) + } -> () +;; + +let _ = + match x with + | { y = + ( Z + (* _____________________________________________________________________ *) + | X _ + | Y _ ) + } -> () +;; + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo +;; + +let get_nullability = function + | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) + | Undef (* This is a very special case, assigning non-null is a technical trick *) -> + Nullability.Nonnull +;; + +let _ = + try () with + | _ -> + ( match () with + | _ -> () + ) +;; + +let _ = + let _ = + try () with + | _ -> + ( try () with + | _ -> () + ) + in + () +;; + +let _ = function + | _ -> + x + >>= (function + | `Halt -> return x + ) + | _ -> () +;; + +let _ = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x + ) + | _ -> () + in + () +;; + +class c = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x + ) + | _ -> () + in + object end diff --git a/test/passing/refs.janestreet/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err b/test/passing/refs.janestreet/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err new file mode 100644 index 0000000000..7dba46c51e --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err @@ -0,0 +1 @@ +Warning: break_cases-closing_on_separate_line_leading_nested_match_parens.ml:293 exceeds the margin diff --git a/test/passing/refs.janestreet/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref b/test/passing/refs.janestreet/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref new file mode 100644 index 0000000000..971aeca6d4 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref @@ -0,0 +1,361 @@ +let f x = function + | C + | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) + | A + | K -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () +;; + +let f = + let g = function + | H when x y <> k -> 2 + | T + | P + | U -> + 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + ( match y with + | O -> 5 + | P when h x -> + (function + | A -> 6 + ) + ) +;; + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + ( match y with + | O -> 5 + | P when h x -> + (function + | A -> 6 + ) + ) + ); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + ( match k with + | foooo -> foooooooo + ); + fooooooooooooooo fooooooooooooo + ) +;; + +match x with +| true -> + ( match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" + ) +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy when fffffffffffffff bbbbbbbbbb yyyyyyyyyy + -> + () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> + ( match y with + | Some _ -> true + | None -> false + ) + in + () +;; + +let () = + match fooooo with + | x -> x +;; + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _) + , Const (Cfun callee_pname) + , (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _ + , loc + , _ + ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc +;; + +let mod_int c1 c2 is_safe dbg = + match c1, c2 with + | c1, Cconst_int (0, _) -> Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x + | -1 -> + () +;; + +let merge_columns l old_table = + let rec aux = function + | [] + | [ None ] -> + [], [] + in + foooooooooooooooooooooooooo fooooooooooooooooooooo +;; + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a +;; + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo +;; + +let () = + match v with + | None -> None + | Some x -> + ( match x with + | None -> None + | Some x -> + ( match x with + | None -> None + | Some x -> x + ) + ) +;; + +let _ = function + | (exception A) + | B -> + 1 + | C -> 2 +;; + +let _ = function + | A + | (exception B) -> + 1 + | C -> 2 +;; + +let _ = + match x with + | (exception A) + | (exception B) -> + 1 + | C -> 2 +;; + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + ) +;; + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> () + end +;; + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () +;; + +let _ = + match x with + | { y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ) + } -> + () +;; + +let _ = + match x with + | { y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ) + } -> + () +;; + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo +;; + +let get_nullability = function + | ArrayAccess + | OptimisticFallback (* non-null is the most optimistic type *) + | Undef (* This is a very special case, assigning non-null is a technical trick *) -> + Nullability.Nonnull +;; + +let _ = + try () with + | _ -> + ( match () with + | _ -> () + ) +;; + +let _ = + let _ = + try () with + | _ -> + ( try () with + | _ -> () + ) + in + () +;; + +let _ = function + | _ -> + x + >>= (function + | `Halt -> return x + ) + | _ -> () +;; + +let _ = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x + ) + | _ -> () + in + () +;; + +class c = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x + ) + | _ -> () + in + object end diff --git a/test/passing/refs.janestreet/break_cases-cosl_lnmp_cmei.ml.err b/test/passing/refs.janestreet/break_cases-cosl_lnmp_cmei.ml.err new file mode 100644 index 0000000000..c6718d611f --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-cosl_lnmp_cmei.ml.err @@ -0,0 +1 @@ +Warning: break_cases-cosl_lnmp_cmei.ml:293 exceeds the margin diff --git a/test/passing/refs.janestreet/break_cases-cosl_lnmp_cmei.ml.ref b/test/passing/refs.janestreet/break_cases-cosl_lnmp_cmei.ml.ref new file mode 100644 index 0000000000..971aeca6d4 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-cosl_lnmp_cmei.ml.ref @@ -0,0 +1,361 @@ +let f x = function + | C + | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) + | A + | K -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () +;; + +let f = + let g = function + | H when x y <> k -> 2 + | T + | P + | U -> + 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + ( match y with + | O -> 5 + | P when h x -> + (function + | A -> 6 + ) + ) +;; + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + ( match y with + | O -> 5 + | P when h x -> + (function + | A -> 6 + ) + ) + ); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + ( match k with + | foooo -> foooooooo + ); + fooooooooooooooo fooooooooooooo + ) +;; + +match x with +| true -> + ( match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" + ) +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy when fffffffffffffff bbbbbbbbbb yyyyyyyyyy + -> + () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> + ( match y with + | Some _ -> true + | None -> false + ) + in + () +;; + +let () = + match fooooo with + | x -> x +;; + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _) + , Const (Cfun callee_pname) + , (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _ + , loc + , _ + ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc +;; + +let mod_int c1 c2 is_safe dbg = + match c1, c2 with + | c1, Cconst_int (0, _) -> Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x + | -1 -> + () +;; + +let merge_columns l old_table = + let rec aux = function + | [] + | [ None ] -> + [], [] + in + foooooooooooooooooooooooooo fooooooooooooooooooooo +;; + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a +;; + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo +;; + +let () = + match v with + | None -> None + | Some x -> + ( match x with + | None -> None + | Some x -> + ( match x with + | None -> None + | Some x -> x + ) + ) +;; + +let _ = function + | (exception A) + | B -> + 1 + | C -> 2 +;; + +let _ = function + | A + | (exception B) -> + 1 + | C -> 2 +;; + +let _ = + match x with + | (exception A) + | (exception B) -> + 1 + | C -> 2 +;; + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + ) +;; + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> () + end +;; + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () +;; + +let _ = + match x with + | { y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ) + } -> + () +;; + +let _ = + match x with + | { y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ) + } -> + () +;; + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo +;; + +let get_nullability = function + | ArrayAccess + | OptimisticFallback (* non-null is the most optimistic type *) + | Undef (* This is a very special case, assigning non-null is a technical trick *) -> + Nullability.Nonnull +;; + +let _ = + try () with + | _ -> + ( match () with + | _ -> () + ) +;; + +let _ = + let _ = + try () with + | _ -> + ( try () with + | _ -> () + ) + in + () +;; + +let _ = function + | _ -> + x + >>= (function + | `Halt -> return x + ) + | _ -> () +;; + +let _ = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x + ) + | _ -> () + in + () +;; + +class c = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x + ) + | _ -> () + in + object end diff --git a/test/passing/refs.janestreet/break_cases-fit_or_vertical.ml.err b/test/passing/refs.janestreet/break_cases-fit_or_vertical.ml.err new file mode 100644 index 0000000000..800710aa40 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-fit_or_vertical.ml.err @@ -0,0 +1 @@ +Warning: break_cases-fit_or_vertical.ml:242 exceeds the margin diff --git a/test/passing/refs.janestreet/break_cases-fit_or_vertical.ml.ref b/test/passing/refs.janestreet/break_cases-fit_or_vertical.ml.ref new file mode 100644 index 0000000000..7a2af593d0 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-fit_or_vertical.ml.ref @@ -0,0 +1,304 @@ +let f x = function + | C | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) | A | K -> 1 + | D -> + let a = "this" in + let b = "breaks" in + () +;; + +let f = + let g = function + | H when x y <> k -> 2 + | T | P | U -> 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z | P | M -> + (match y with + | O -> 5 + | P when h x -> + (function + | A -> 6)) +;; + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z | P | M -> + (match y with + | O -> 5 + | P when h x -> + (function + | A -> 6))); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + (match k with + | foooo -> foooooooo); + fooooooooooooooo fooooooooooooo) +;; + +match x with +| true -> + (match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy when fffffffffffffff bbbbbbbbbb yyyyyyyyyy + -> () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> + (match y with + | Some _ -> true + | None -> false) + in + () +;; + +let () = + match fooooo with + | x -> x +;; + +let () = + match foooo with + | x | x | x -> x + | y | foooooooooo | fooooooooo -> y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _) + , Const (Cfun callee_pname) + , (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _ + , loc + , _ ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc +;; + +let mod_int c1 c2 is_safe dbg = + match c1, c2 with + | c1, Cconst_int (0, _) -> Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x | -1 -> () +;; + +let merge_columns l old_table = + let rec aux = function + | [] | [ None ] -> [], [] + in + foooooooooooooooooooooooooo fooooooooooooooooooooo +;; + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let () = + match foooo with + | x | x | x -> x + | y | foooooooooo | fooooooooo -> y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a +;; + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo +;; + +let () = + match v with + | None -> None + | Some x -> + (match x with + | None -> None + | Some x -> + (match x with + | None -> None + | Some x -> x)) +;; + +let _ = function + | (exception A) | B -> 1 + | C -> 2 +;; + +let _ = function + | A | (exception B) -> 1 + | C -> 2 +;; + +let _ = + match x with + | (exception A) | (exception B) -> 1 + | C -> 2 +;; + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo) +;; + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> Errors.isset_in_strict p + | _ -> () + end +;; + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> () +;; + +let _ = + match x with + | { y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ) + } -> () +;; + +let _ = + match x with + | { y = + ( Z + (* _____________________________________________________________________ *) + | X _ + | Y _ ) + } -> () +;; + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo +;; + +let get_nullability = function + | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) + | Undef (* This is a very special case, assigning non-null is a technical trick *) -> + Nullability.Nonnull +;; + +let _ = + try () with + | _ -> + (match () with + | _ -> ()) +;; + +let _ = + let _ = + try () with + | _ -> + (try () with + | _ -> ()) + in + () +;; + +let _ = function + | _ -> + x + >>= (function + | `Halt -> return x) + | _ -> () +;; + +let _ = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x) + | _ -> () + in + () +;; + +class c = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x) + | _ -> () + in + object end diff --git a/test/passing/refs.janestreet/break_cases-nested.ml.err b/test/passing/refs.janestreet/break_cases-nested.ml.err new file mode 100644 index 0000000000..a8cab0126f --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-nested.ml.err @@ -0,0 +1 @@ +Warning: break_cases-nested.ml:236 exceeds the margin diff --git a/test/passing/refs.janestreet/break_cases-nested.ml.ref b/test/passing/refs.janestreet/break_cases-nested.ml.ref new file mode 100644 index 0000000000..d7384712e2 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-nested.ml.ref @@ -0,0 +1,271 @@ +let f x = function + | C | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) | A | K -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () +;; + +let f = + let g = function H when x y <> k -> 2 | T | P | U -> 3 in + fun x g t h y u -> + match x with + | E -> + 4 + | Z | P | M -> + (match y with O -> 5 | P when h x -> (function A -> 6)) +;; + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> + 4 + | Z | P | M -> + (match y with O -> 5 | P when h x -> (function A -> 6))); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + (match k with foooo -> foooooooo); + fooooooooooooooo fooooooooooooo) +;; + +match x with +| true -> + (match y with + | true -> + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> + "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") +| false -> + "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy when fffffffffffffff bbbbbbbbbb yyyyyyyyyy + -> + () +| _ -> + () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> + false +;; + +let _ = + let f x y = + match x with + | None -> + false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> + (match y with Some _ -> true | None -> false) + in + () +;; + +let () = match fooooo with x -> x + +let () = + match foooo with + | x | x | x -> + x + | y | foooooooooo | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _) + , Const (Cfun callee_pname) + , (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _ + , loc + , _ ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc +;; + +let mod_int c1 c2 is_safe dbg = + match c1, c2 with + | c1, Cconst_int (0, _) -> + Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> + Csequence (c1, Cconst_int (0, dbg)) + | x | -1 -> + () +;; + +let merge_columns l old_table = + let rec aux = function [] | [ None ] -> [], [] in + foooooooooooooooooooooooooo fooooooooooooooooooooo +;; + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> + false +;; + +let () = + match foooo with + | x | x | x -> + x + | y | foooooooooo | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a +;; + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> + fooooooooooooooooo +;; + +let () = + match v with + | None -> + None + | Some x -> + (match x with None -> None | Some x -> (match x with None -> None | Some x -> x)) +;; + +let _ = function (exception A) | B -> 1 | C -> 2 +let _ = function A | (exception B) -> 1 | C -> 2 +let _ = match x with (exception A) | (exception B) -> 1 | C -> 2 + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> + fooooooooooo + | foooooooooo -> + fooooooooooo + | foooooooooo -> + fooooooooooo) +;; + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> + () + end +;; + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () +;; + +let _ = + match x with + | { y = + (* _____________________________________________________________________ *) + ( X _ + | Y _ ) + } -> + () +;; + +let _ = + match x with + | { y = + ( Z + (* _____________________________________________________________________ *) + | X _ + | Y _ ) + } -> + () +;; + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo +;; + +let get_nullability = function + | ArrayAccess + | OptimisticFallback (* non-null is the most optimistic type *) + | Undef (* This is a very special case, assigning non-null is a technical trick *) -> + Nullability.Nonnull +;; + +let _ = try () with _ -> (match () with _ -> ()) + +let _ = + let _ = try () with _ -> (try () with _ -> ()) in + () +;; + +let _ = function _ -> x >>= (function `Halt -> return x) | _ -> () + +let _ = + let _ = function _ -> x >>= (function `Halt -> return x) | _ -> () in + () +;; + +class c = + let _ = function _ -> x >>= (function `Halt -> return x) | _ -> () in + object end diff --git a/test/passing/refs.janestreet/break_cases-normal_indent.ml.err b/test/passing/refs.janestreet/break_cases-normal_indent.ml.err new file mode 100644 index 0000000000..c02e160783 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-normal_indent.ml.err @@ -0,0 +1 @@ +Warning: break_cases-normal_indent.ml:280 exceeds the margin diff --git a/test/passing/refs.janestreet/break_cases-normal_indent.ml.ref b/test/passing/refs.janestreet/break_cases-normal_indent.ml.ref new file mode 100644 index 0000000000..8ee47e0864 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-normal_indent.ml.ref @@ -0,0 +1,343 @@ +let f x = function + | C + | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) + | A + | K -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () +;; + +let f = + let g = function + | H when x y <> k -> 2 + | T + | P + | U -> + 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + (match y with + | O -> 5 + | P when h x -> + (function + | A -> 6)) +;; + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z + | P + | M -> + (match y with + | O -> 5 + | P when h x -> + (function + | A -> 6))); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + (match k with + | foooo -> foooooooo); + fooooooooooooooo fooooooooooooo) +;; + +match x with +| true -> + (match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy when fffffffffffffff bbbbbbbbbb yyyyyyyyyy + -> + () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> + (match y with + | Some _ -> true + | None -> false) + in + () +;; + +let () = + match fooooo with + | x -> x +;; + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _) + , Const (Cfun callee_pname) + , (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _ + , loc + , _ ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc +;; + +let mod_int c1 c2 is_safe dbg = + match c1, c2 with + | c1, Cconst_int (0, _) -> Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x + | -1 -> + () +;; + +let merge_columns l old_table = + let rec aux = function + | [] + | [ None ] -> + [], [] + in + foooooooooooooooooooooooooo fooooooooooooooooooooo +;; + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a +;; + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo +;; + +let () = + match v with + | None -> None + | Some x -> + (match x with + | None -> None + | Some x -> + (match x with + | None -> None + | Some x -> x)) +;; + +let _ = function + | (exception A) + | B -> + 1 + | C -> 2 +;; + +let _ = function + | A + | (exception B) -> + 1 + | C -> 2 +;; + +let _ = + match x with + | (exception A) + | (exception B) -> + 1 + | C -> 2 +;; + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo) +;; + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> () + end +;; + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () +;; + +let _ = + match x with + | { y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ) + } -> + () +;; + +let _ = + match x with + | { y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ) + } -> + () +;; + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo +;; + +let get_nullability = function + | ArrayAccess + | OptimisticFallback (* non-null is the most optimistic type *) + | Undef (* This is a very special case, assigning non-null is a technical trick *) -> + Nullability.Nonnull +;; + +let _ = + try () with + | _ -> + (match () with + | _ -> ()) +;; + +let _ = + let _ = + try () with + | _ -> + (try () with + | _ -> ()) + in + () +;; + +let _ = function + | _ -> + x + >>= (function + | `Halt -> return x) + | _ -> () +;; + +let _ = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x) + | _ -> () + in + () +;; + +class c = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x) + | _ -> () + in + object end diff --git a/test/passing/refs.janestreet/break_cases-toplevel.ml.err b/test/passing/refs.janestreet/break_cases-toplevel.ml.err new file mode 100644 index 0000000000..a8a31fc628 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-toplevel.ml.err @@ -0,0 +1 @@ +Warning: break_cases-toplevel.ml:244 exceeds the margin diff --git a/test/passing/refs.janestreet/break_cases-toplevel.ml.ref b/test/passing/refs.janestreet/break_cases-toplevel.ml.ref new file mode 100644 index 0000000000..7e6aa9fe83 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-toplevel.ml.ref @@ -0,0 +1,305 @@ +let f x = function + | C | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) | A | K -> 1 + | D -> + let a = "this" in + let b = "breaks" in + () +;; + +let f = + let g = function + | H when x y <> k -> 2 + | T | P | U -> 3 + in + fun x g t h y u -> + match x with + | E -> 4 + | Z | P | M -> + (match y with + | O -> 5 + | P when h x -> + (function + | A -> 6)) +;; + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z | P | M -> + (match y with + | O -> 5 + | P when h x -> + (function + | A -> 6))); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + (match k with + | foooo -> foooooooo); + fooooooooooooooo fooooooooooooo) +;; + +match x with +| true -> + (match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy when fffffffffffffff bbbbbbbbbb yyyyyyyyyy + -> + () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> + (match y with + | Some _ -> true + | None -> false) + in + () +;; + +let () = + match fooooo with + | x -> x +;; + +let () = + match foooo with + | x | x | x -> x + | y | foooooooooo | fooooooooo -> y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _) + , Const (Cfun callee_pname) + , (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _ + , loc + , _ ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc +;; + +let mod_int c1 c2 is_safe dbg = + match c1, c2 with + | c1, Cconst_int (0, _) -> Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x | -1 -> () +;; + +let merge_columns l old_table = + let rec aux = function + | [] | [ None ] -> [], [] + in + foooooooooooooooooooooooooo fooooooooooooooooooooo +;; + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let () = + match foooo with + | x | x | x -> x + | y | foooooooooo | fooooooooo -> y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a +;; + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa | Bbbbbbbbbbbbbbbbb | Ccccccccccccccccc | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo +;; + +let () = + match v with + | None -> None + | Some x -> + (match x with + | None -> None + | Some x -> + (match x with + | None -> None + | Some x -> x)) +;; + +let _ = function + | (exception A) | B -> 1 + | C -> 2 +;; + +let _ = function + | A | (exception B) -> 1 + | C -> 2 +;; + +let _ = + match x with + | (exception A) | (exception B) -> 1 + | C -> 2 +;; + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo) +;; + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> () + end +;; + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () +;; + +let _ = + match x with + | { y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ) + } -> + () +;; + +let _ = + match x with + | { y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ) + } -> + () +;; + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo +;; + +let get_nullability = function + | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) + | Undef (* This is a very special case, assigning non-null is a technical trick *) -> + Nullability.Nonnull +;; + +let _ = + try () with + | _ -> + (match () with + | _ -> ()) +;; + +let _ = + let _ = + try () with + | _ -> + (try () with + | _ -> ()) + in + () +;; + +let _ = function + | _ -> + x + >>= (function + | `Halt -> return x) + | _ -> () +;; + +let _ = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x) + | _ -> () + in + () +;; + +class c = + let _ = function + | _ -> + x + >>= (function + | `Halt -> return x) + | _ -> () + in + object end diff --git a/test/passing/refs.janestreet/break_cases-vertical.ml.err b/test/passing/refs.janestreet/break_cases-vertical.ml.err new file mode 100644 index 0000000000..b91909954b --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-vertical.ml.err @@ -0,0 +1 @@ +Warning: break_cases-vertical.ml:313 exceeds the margin diff --git a/test/passing/refs.janestreet/break_cases-vertical.ml.ref b/test/passing/refs.janestreet/break_cases-vertical.ml.ref new file mode 100644 index 0000000000..e47f0215d8 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases-vertical.ml.ref @@ -0,0 +1,384 @@ +let f x = function + | C + | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) + | A + | K -> + 1 + | D -> + let a = "this" in + let b = "breaks" in + () +;; + +let f = + let g = function + | H when x y <> k -> + 2 + | T + | P + | U -> + 3 + in + fun x g t h y u -> + match x with + | E -> + 4 + | Z + | P + | M -> + (match y with + | O -> + 5 + | P when h x -> + (function + | A -> + 6)) +;; + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> + 4 + | Z + | P + | M -> + (match y with + | O -> + 5 + | P when h x -> + (function + | A -> + 6))); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + (match k with + | foooo -> + foooooooo); + fooooooooooooooo fooooooooooooo) +;; + +match x with +| true -> + (match y with + | true -> + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> + "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") +| false -> + "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy when fffffffffffffff bbbbbbbbbb yyyyyyyyyy + -> + () +| _ -> + () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> + false +;; + +let _ = + let f x y = + match x with + | None -> + false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> + (match y with + | Some _ -> + true + | None -> + false) + in + () +;; + +let () = + match fooooo with + | x -> + x +;; + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _) + , Const (Cfun callee_pname) + , (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _ + , loc + , _ ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc +;; + +let mod_int c1 c2 is_safe dbg = + match c1, c2 with + | c1, Cconst_int (0, _) -> + Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> + Csequence (c1, Cconst_int (0, dbg)) + | x + | -1 -> + () +;; + +let merge_columns l old_table = + let rec aux = function + | [] + | [ None ] -> + [], [] + in + foooooooooooooooooooooooooo fooooooooooooooooooooo +;; + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> + false +;; + +let () = + match foooo with + | x + | x + | x -> + x + | y + | foooooooooo + | fooooooooo -> + y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a +;; + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa + | Bbbbbbbbbbbbbbbbb + | Ccccccccccccccccc + | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> + fooooooooooooooooo +;; + +let () = + match v with + | None -> + None + | Some x -> + (match x with + | None -> + None + | Some x -> + (match x with + | None -> + None + | Some x -> + x)) +;; + +let _ = function + | (exception A) + | B -> + 1 + | C -> + 2 +;; + +let _ = function + | A + | (exception B) -> + 1 + | C -> + 2 +;; + +let _ = + match x with + | (exception A) + | (exception B) -> + 1 + | C -> + 2 +;; + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> + fooooooooooo + | foooooooooo -> + fooooooooooo + | foooooooooo -> + fooooooooooo) +;; + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> + () + end +;; + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () +;; + +let _ = + match x with + | { y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ) + } -> + () +;; + +let _ = + match x with + | { y = + ( Z + (* _____________________________________________________________________ *) + | X _ + | Y _ ) + } -> + () +;; + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo + | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo +;; + +let get_nullability = function + | ArrayAccess + | OptimisticFallback (* non-null is the most optimistic type *) + | Undef (* This is a very special case, assigning non-null is a technical trick *) -> + Nullability.Nonnull +;; + +let _ = + try () with + | _ -> + (match () with + | _ -> + ()) +;; + +let _ = + let _ = + try () with + | _ -> + (try () with + | _ -> + ()) + in + () +;; + +let _ = function + | _ -> + x + >>= (function + | `Halt -> + return x) + | _ -> + () +;; + +let _ = + let _ = function + | _ -> + x + >>= (function + | `Halt -> + return x) + | _ -> + () + in + () +;; + +class c = + let _ = function + | _ -> + x + >>= (function + | `Halt -> + return x) + | _ -> + () + in + object end diff --git a/test/passing/refs.janestreet/break_cases.ml.err b/test/passing/refs.janestreet/break_cases.ml.err new file mode 100644 index 0000000000..a905cb7c8d --- /dev/null +++ b/test/passing/refs.janestreet/break_cases.ml.err @@ -0,0 +1 @@ +Warning: break_cases.ml:206 exceeds the margin diff --git a/test/passing/refs.janestreet/break_cases.ml.ref b/test/passing/refs.janestreet/break_cases.ml.ref new file mode 100644 index 0000000000..4a143f2da2 --- /dev/null +++ b/test/passing/refs.janestreet/break_cases.ml.ref @@ -0,0 +1,239 @@ +let f x = function + | C | P (this, test, [ is; wide; enough; _to; break ], [ the; line ]) | A | K -> 1 + | D -> + let a = "this" in + let b = "breaks" in + () +;; + +let f = + let g = function H when x y <> k -> 2 | T | P | U -> 3 in + fun x g t h y u -> + match x with + | E -> 4 + | Z | P | M -> (match y with O -> 5 | P when h x -> (function A -> 6)) +;; + +let foo = + List.map ~f:(fun x g t h y u -> + match x with + | E -> 4 + | Z | P | M -> (match y with O -> 5 | P when h x -> (function A -> 6))); + List.map ~f:(fun x g t h y u -> + fooooooooooooo foooooooo; + (match k with foooo -> foooooooo); + fooooooooooooooo fooooooooooooo) +;; + +match x with +| true -> + (match y with + | true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + | false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") +| false -> "cccccccccccccccccccccccccccccc" +;; + +match x with +| "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", yyyyyyyyyy when fffffffffffffff bbbbbbbbbb yyyyyyyyyy + -> + () +| _ -> () + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let _ = + let f x y = + match x with + | None -> false + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> + (match y with Some _ -> true | None -> false) + in + () +;; + +let () = match fooooo with x -> x + +let () = + match foooo with + | x | x | x -> x + | y | foooooooooo | fooooooooo -> y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let foo = + match instr with + | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc) when Pvar.is_ssa_frontend_tmp lhs_pvar -> + (* do not need to add deref here as it is added implicitly in of_pvar + by forgetting the & *) + analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc + | Call + ( (ret_id, _) + , Const (Cfun callee_pname) + , (target_exp, _) :: (Sizeof { typ = cast_typ }, _) :: _ + , loc + , _ ) + when Typ.Procname.equal callee_pname BuiltinDecl.__cast -> + analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc +;; + +let mod_int c1 c2 is_safe dbg = + match c1, c2 with + | c1, Cconst_int (0, _) -> Csequence (c1, raise_symbol dbg "caml_exn_Division_by_zero") + | c1, Cconst_int ((1 | -1), _) -> Csequence (c1, Cconst_int (0, dbg)) + | x | -1 -> () +;; + +let merge_columns l old_table = + let rec aux = function [] | [ None ] -> [], [] in + foooooooooooooooooooooooooo fooooooooooooooooooooo +;; + +[@@@ocamlformat "indicate-nested-or-patterns=unsafe-no"] + +let is_sequence exp = + match exp.pexp_desc with + | Pexp_sequence _ + | Pexp_extension + (_, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_sequence _ }, []); _ } ]) -> + true + | _ -> false +;; + +let () = + match foooo with + | x | x | x -> x + | y | foooooooooo | fooooooooo -> y + | foooooo when ff fff fooooooooooooooooooo -> + foooooooooooooooooooooo foooooooooooooooooo +;; + +let rec loop items = + match [] with + | _ :: _ :: items -> + (* a comment *) + loop items + | _ :: items -> + (* another comment*) + loop items + | _ -> + let a = 3 in + a +;; + +let ffffff ~foo = + match (foo : Fooooooooooooo.t) with + | Aaaaaaaaaaaaaaaaa | Bbbbbbbbbbbbbbbbb | Ccccccccccccccccc | Ddddddddddddddddd + | Eeeeeeeeeeeeeeeee -> + foooooooooooooooooooo + | Fffffffffffffffff -> fooooooooooooooooo +;; + +let () = + match v with + | None -> None + | Some x -> + (match x with None -> None | Some x -> (match x with None -> None | Some x -> x)) +;; + +let _ = function (exception A) | B -> 1 | C -> 2 +let _ = function A | (exception B) -> 1 | C -> 2 +let _ = match x with (exception A) | (exception B) -> 1 | C -> 2 + +let _ = + match x with + | fooooooooooooooooo -> + assert ( + match fooooooooo with + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo + | foooooooooo -> fooooooooooo) +;; + +let handler = + object + method at_expr x = + match x with + | Call Thing + (* isset($var::thing) but not isset($foo::$bar) *) + | Call OtherThing -> + Errors.isset_in_strict p + | _ -> () + end +;; + +let _ = + match abc with + | Fooooooooooooooooo (* comment *) + | Baaaaaaaaaaaaaaaar + (* comment *) + | Baaaaaaaaaaaaaaaaz (* comment *) -> + () +;; + +let _ = + match x with + | { y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ) + } -> + () +;; + +let _ = + match x with + | { y = + ( Z + (* _____________________________________________________________________ *) + | X _ | Y _ ) + } -> + () +;; + +let foooooooooooooo = function + | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foooooooooooooooo (* foooooo foooo fooooooooooo *) + | Foooooooooooooo _ + (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. + Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + | Foooo (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) -> + Foooooooooo.Foooooo + | Foooo { foooo_fooo = { foooooooooo } } -> + Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo +;; + +let get_nullability = function + | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) + | Undef (* This is a very special case, assigning non-null is a technical trick *) -> + Nullability.Nonnull +;; + +let _ = try () with _ -> (match () with _ -> ()) + +let _ = + let _ = try () with _ -> (try () with _ -> ()) in + () +;; + +let _ = function _ -> x >>= (function `Halt -> return x) | _ -> () + +let _ = + let _ = function _ -> x >>= (function `Halt -> return x) | _ -> () in + () +;; + +class c = + let _ = function _ -> x >>= (function `Halt -> return x) | _ -> () in + object end diff --git a/test/passing/refs.janestreet/break_collection_expressions-wrap.ml.ref b/test/passing/refs.janestreet/break_collection_expressions-wrap.ml.ref new file mode 100644 index 0000000000..7b085f2e4f --- /dev/null +++ b/test/passing/refs.janestreet/break_collection_expressions-wrap.ml.ref @@ -0,0 +1,63 @@ +let _ = + [ a; b (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) ] +;; + +let [ fooooooooooooooooooooooooooooooo; fooooooooooooooooooooooooooooooo + ; fooooooooooooooooooooooooooooooo (* before end of the list *) ] + = + [ fooooooooooooooooooooooooooooooo; fooooooooooooooooooooooooooooooo + ; fooooooooooooooooooooooooooooooo + (* after all elements *) + (* after all elements as well *) ] +;; + +let [| fooooooooooooooooooooooooooooooo; fooooooooooooooooooooooooooooooo + ; fooooooooooooooooooooooooooooooo (* before end of the array *) |] + = + [| fooooooooooooooooooooooooooooooo; fooooooooooooooooooooooooooooooo + ; fooooooooooooooooooooooooooooooo + (* after all elements *) + (* after all elements as well *) |] +;; + +let { fooooooooooooooooooooooooooooooo + ; fooooooooooooooooooooooooooooooo + ; fooooooooooooooooooooooooooooooo + ; _ (* xxx *) + } + = + { fooooooooooooooooooooooooooooooo = x + ; fooooooooooooooooooooooooooooooo = y + ; fooooooooooooooooooooooooooooooo = z (* after all fields *) + } +;; + +let length = + [| 0; 269999999999999999999999999999999999999999999999999; 26; (* foo *) 27 (* foo *) + ; 27; 27 |] + [@foo] +;; + +let length = + [ 0; 14; (* foo *) 14; 17 (* foo *); 17; 2777777777777777777777777777777777; 27 ] [@foo] +;; + +let length = + [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 8; 9; 9; 10; 10; 11; 11; 12; 12; 12; 12; 13; 25; 25; 25 + ; 25; 25; 25; 25; 25; 25; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26 + ; 269999999999999999999999999999999999999999999999999; 26; 26; 26; 26; 26; 26; 26; 26 + ; 26; 26; 26; 26; 26; 26; 26; 26; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27 + ; 27; 27; 27; 27; 27; 27; 27; 27; (* foo *) 27 (* foo *); 27; 27; 27; 27; 27; 27; 27 + ; 27; 27; 28 |] + [@foo] +;; + +let length = + [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 8; 9; 9; 10; 10; 11; 11; 12; 12; 12; 12; 13; 13; 13; 13; 14 + ; 14; 14; (* foo *) 14; 15; 15; 15; 15; 16; 16; 16; 16; 16; 16; 16; 16; 17; 17; 17 + ; 17 (* foo *); 17; 17; 17; 17; 18; 18; 18; 18; 18; 18; 18; 18; 19; 19; 19; 19; 19; 19 + ; 19; 19; 20; 20; 20; 20; 20; 20; 20; 20; 20; 20; 20; 26; 26; 26; 26; 26; 27; 27; 27; 27 + ; 2777777777777777777777777777777777; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27 + ; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 28 ] + [@foo] +;; diff --git a/test/passing/refs.janestreet/break_collection_expressions.ml.ref b/test/passing/refs.janestreet/break_collection_expressions.ml.ref new file mode 100644 index 0000000000..96a0f4df9e --- /dev/null +++ b/test/passing/refs.janestreet/break_collection_expressions.ml.ref @@ -0,0 +1,273 @@ +let _ = + [ a; b (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) ] +;; + +let [ fooooooooooooooooooooooooooooooo + ; fooooooooooooooooooooooooooooooo + ; fooooooooooooooooooooooooooooooo (* before end of the list *) + ] + = + [ fooooooooooooooooooooooooooooooo + ; fooooooooooooooooooooooooooooooo + ; fooooooooooooooooooooooooooooooo + (* after all elements *) + (* after all elements as well *) + ] +;; + +let [| fooooooooooooooooooooooooooooooo + ; fooooooooooooooooooooooooooooooo + ; fooooooooooooooooooooooooooooooo (* before end of the array *) + |] + = + [| fooooooooooooooooooooooooooooooo + ; fooooooooooooooooooooooooooooooo + ; fooooooooooooooooooooooooooooooo + (* after all elements *) + (* after all elements as well *) + |] +;; + +let { fooooooooooooooooooooooooooooooo + ; fooooooooooooooooooooooooooooooo + ; fooooooooooooooooooooooooooooooo + ; _ (* xxx *) + } + = + { fooooooooooooooooooooooooooooooo = x + ; fooooooooooooooooooooooooooooooo = y + ; fooooooooooooooooooooooooooooooo = z (* after all fields *) + } +;; + +let length = + [| 0 + ; 269999999999999999999999999999999999999999999999999 + ; 26 + ; (* foo *) 27 (* foo *) + ; 27 + ; 27 + |] + [@foo] +;; + +let length = + [ 0; 14; (* foo *) 14; 17 (* foo *); 17; 2777777777777777777777777777777777; 27 ] [@foo] +;; + +let length = + [| 0 + ; 1 + ; 2 + ; 3 + ; 4 + ; 5 + ; 6 + ; 7 + ; 8 + ; 8 + ; 9 + ; 9 + ; 10 + ; 10 + ; 11 + ; 11 + ; 12 + ; 12 + ; 12 + ; 12 + ; 13 + ; 25 + ; 25 + ; 25 + ; 25 + ; 25 + ; 25 + ; 25 + ; 25 + ; 25 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 269999999999999999999999999999999999999999999999999 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; (* foo *) 27 (* foo *) + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 28 + |] + [@foo] +;; + +let length = + [ 0 + ; 1 + ; 2 + ; 3 + ; 4 + ; 5 + ; 6 + ; 7 + ; 8 + ; 8 + ; 9 + ; 9 + ; 10 + ; 10 + ; 11 + ; 11 + ; 12 + ; 12 + ; 12 + ; 12 + ; 13 + ; 13 + ; 13 + ; 13 + ; 14 + ; 14 + ; 14 + ; (* foo *) + 14 + ; 15 + ; 15 + ; 15 + ; 15 + ; 16 + ; 16 + ; 16 + ; 16 + ; 16 + ; 16 + ; 16 + ; 16 + ; 17 + ; 17 + ; 17 + ; 17 (* foo *) + ; 17 + ; 17 + ; 17 + ; 17 + ; 18 + ; 18 + ; 18 + ; 18 + ; 18 + ; 18 + ; 18 + ; 18 + ; 19 + ; 19 + ; 19 + ; 19 + ; 19 + ; 19 + ; 19 + ; 19 + ; 20 + ; 20 + ; 20 + ; 20 + ; 20 + ; 20 + ; 20 + ; 20 + ; 20 + ; 20 + ; 20 + ; 26 + ; 26 + ; 26 + ; 26 + ; 26 + ; 27 + ; 27 + ; 27 + ; 27 + ; 2777777777777777777777777777777777 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 27 + ; 28 + ] + [@foo] +;; diff --git a/test/passing/refs.janestreet/break_colon-before.ml.ref b/test/passing/refs.janestreet/break_colon-before.ml.ref new file mode 100644 index 0000000000..c0c3c35a43 --- /dev/null +++ b/test/passing/refs.janestreet/break_colon-before.ml.ref @@ -0,0 +1,97 @@ +(* Bad: unboxing the function type *) +external i : (int -> float[@unboxed]) = "i" "i_nat" + +module type M = sig + (** Formatting action: input type and source, and output destination. *) + val action : action + + val doc_atrs + : (string Location.loc * payload) list + -> (string Location.loc * bool) list option * (string Location.loc * payload) list + + val transl_modtype_longident + (* from Typemod *) + : (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val transl_modtype_longident + (* foooooooooo fooooooooooooo foooooooooooo foooooooooooooo + foooooooooooooo foooooooooooo *) + : (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val imported_sets_of_closures_table + : Simple_value_approx.function_declarations option Set_of_closures_id.Tbl.t + + type 'a option_decl = + names:string list + -> doc:string + -> section:[ `Formatting | `Operational ] + -> ?allow_inline:bool + -> (config -> 'a -> config) + -> (config -> 'a) + -> 'a t + + val select + : (* The fsevents context *) + env + -> (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list + -> (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list + -> (* Timeout...like Unix.select *) + timeout:float + -> (* The callback for file system events *) + (event list -> unit) + -> unit + + val f + : x:t + (** an extremely long comment about [x] that does not fit on the + same line with [x] *) + -> unit + + val f + : fooooooooooooooooo: + (fooooooooooooooo + -> fooooooooooooooooooo + -> foooooooooooooo + -> foooooooooooooo * fooooooooooooooooo + -> foooooooooooooooo) + (** an extremely long comment about [x] that does not fit on the + same line with [x] *) + -> unit +end + +let ssmap + : (module MapT with type key = string and type data = string and type map = SSMap.map) + = + () +;; + +let ssmap + : (module MapT with type key = string and type data = string and type map = SSMap.map) + -> unit + = + () +;; + +let long_function_name : type a. a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit + = + fun () -> () +;; + +let array_fold_transf (f : numbering -> 'a -> numbering * 'b) n (a : 'a array) + : numbering * 'b array + = + match Array.length a with + | 0 -> n, [||] + | 1 -> x +;; + +let to_clambda_function (id, (function_decl : Flambda.function_declaration)) + : Clambda.ufunction + = + (* All that we need in the environment, for translating one closure from a + closed set of closures, is the substitutions for variables bound to the + various closures in the set. Such closures will always be ... *) + x +;; diff --git a/test/passing/refs.janestreet/break_colon.ml.ref b/test/passing/refs.janestreet/break_colon.ml.ref new file mode 100644 index 0000000000..0114d5baf6 --- /dev/null +++ b/test/passing/refs.janestreet/break_colon.ml.ref @@ -0,0 +1,97 @@ +(* Bad: unboxing the function type *) +external i : (int -> float[@unboxed]) = "i" "i_nat" + +module type M = sig + (** Formatting action: input type and source, and output destination. *) + val action : action + + val doc_atrs : + (string Location.loc * payload) list + -> (string Location.loc * bool) list option * (string Location.loc * payload) list + + val transl_modtype_longident + (* from Typemod *) : + (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val transl_modtype_longident + (* foooooooooo fooooooooooooo foooooooooooo foooooooooooooo + foooooooooooooo foooooooooooo *) : + (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val imported_sets_of_closures_table : + Simple_value_approx.function_declarations option Set_of_closures_id.Tbl.t + + type 'a option_decl = + names:string list + -> doc:string + -> section:[ `Formatting | `Operational ] + -> ?allow_inline:bool + -> (config -> 'a -> config) + -> (config -> 'a) + -> 'a t + + val select : + (* The fsevents context *) + env + -> (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list + -> (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list + -> (* Timeout...like Unix.select *) + timeout:float + -> (* The callback for file system events *) + (event list -> unit) + -> unit + + val f : + x:t + (** an extremely long comment about [x] that does not fit on the + same line with [x] *) + -> unit + + val f : + fooooooooooooooooo: + (fooooooooooooooo + -> fooooooooooooooooooo + -> foooooooooooooo + -> foooooooooooooo * fooooooooooooooooo + -> foooooooooooooooo) + (** an extremely long comment about [x] that does not fit on the + same line with [x] *) + -> unit +end + +let ssmap : + (module MapT with type key = string and type data = string and type map = SSMap.map) + = + () +;; + +let ssmap : + (module MapT with type key = string and type data = string and type map = SSMap.map) + -> unit + = + () +;; + +let long_function_name : type a. a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit + = + fun () -> () +;; + +let array_fold_transf (f : numbering -> 'a -> numbering * 'b) n (a : 'a array) : + numbering * 'b array + = + match Array.length a with + | 0 -> n, [||] + | 1 -> x +;; + +let to_clambda_function (id, (function_decl : Flambda.function_declaration)) : + Clambda.ufunction + = + (* All that we need in the environment, for translating one closure from a + closed set of closures, is the substitutions for variables bound to the + various closures in the set. Such closures will always be ... *) + x +;; diff --git a/test/passing/refs.janestreet/break_fun_decl-fit_or_vertical.ml.ref b/test/passing/refs.janestreet/break_fun_decl-fit_or_vertical.ml.ref new file mode 100644 index 0000000000..e4c8ccd1eb --- /dev/null +++ b/test/passing/refs.janestreet/break_fun_decl-fit_or_vertical.ml.ref @@ -0,0 +1,163 @@ +class t = + object + method meth + aaaaaaaaaaa + bbbbbbbbbbbbbb + ccccccccccccccccccc + ddddddddddddddddddddd + eeeeeeeeeeeeeee = + body + end + +let func + aaaaaaaaaaa + bbbbbbbbbbbbbb + ccccccccccccccccccc + ddddddddddddddddddddd + eeeeeeeeeeeeeee + = + body +;; + +let rec func + aaaaaaaaaaa + bbbbbbbbbbbbbb + ccccccccccccccccccc + ddddddddddddddddddddd + eeeeeeeeeeeeeee + = + body +;; + +let ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc + = + g +;; + +let ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc + dddddddddddddddddddddd + = + g +;; + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +class ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc = g + +class ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc + dddddddddddddddddddddd = g + +let ffffffffffffffffffff : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb -> cccccccccccccccccccccc + = + g +;; + +let ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd + = + g +;; + +let fffffffffffffffffffffffffffffffffff x yyyyyyyyyyyyyyyyyyyyyyyyyyy = () + +let fffffffffffffffffffffffffffffffffff + x + yyyyyyyyyyyyyyyyyyyyyyyyyyy + yyyyyyyyyyyyyyyyyyyyyyyyyyy + = + () +;; + +class ffffffffffffffffffff = + object + method ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd = + g + + val ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd = + g + end + +class type ffffffffffffffffffff = object + method ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd + + val ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd + + val ffffffffffffffffffff : + (aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd) + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd +end + +let _ = + fun (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) -> + body +;; + +let _ = + f + (fun + (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) + -> body) +;; + +let f + (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) + = + body +;; + +(* Inconsistent formatting of fun arguments. *) + +let new_specialised_args = + Variable.Map.mapi + (fun new_inner_var______ (definition : Definition.t) : Flambda.specialised_to -> ()) + foo +;; + +let new_specialised_args = + Variable.Map.mapi + (fun new_inner_var______ (definition : Definition.t) : Flambda.specialised_to -> ()) +;; diff --git a/test/passing/refs.janestreet/break_fun_decl-smart.ml.ref b/test/passing/refs.janestreet/break_fun_decl-smart.ml.ref new file mode 100644 index 0000000000..8587c916ec --- /dev/null +++ b/test/passing/refs.janestreet/break_fun_decl-smart.ml.ref @@ -0,0 +1,150 @@ +class t = + object + method meth + aaaaaaaaaaa bbbbbbbbbbbbbb ccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeee + = + body + end + +let func + aaaaaaaaaaa bbbbbbbbbbbbbb ccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeee + = + body +;; + +let rec func + aaaaaaaaaaa + bbbbbbbbbbbbbb + ccccccccccccccccccc + ddddddddddddddddddddd + eeeeeeeeeeeeeee + = + body +;; + +let ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccc + = + g +;; + +let ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc + dddddddddddddddddddddd + = + g +;; + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +class ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccc = g + +class ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc + dddddddddddddddddddddd = g + +let ffffffffffffffffffff : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb -> cccccccccccccccccccccc + = + g +;; + +let ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd + = + g +;; + +let fffffffffffffffffffffffffffffffffff x yyyyyyyyyyyyyyyyyyyyyyyyyyy = () + +let fffffffffffffffffffffffffffffffffff + x yyyyyyyyyyyyyyyyyyyyyyyyyyy yyyyyyyyyyyyyyyyyyyyyyyyyyy + = + () +;; + +class ffffffffffffffffffff = + object + method ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd = + g + + val ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd = + g + end + +class type ffffffffffffffffffff = object + method ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd + + val ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd + + val ffffffffffffffffffff : + (aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd) + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd +end + +let _ = + fun (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) -> + body +;; + +let _ = + f + (fun + (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) + -> body) +;; + +let f + (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) + = + body +;; + +(* Inconsistent formatting of fun arguments. *) + +let new_specialised_args = + Variable.Map.mapi + (fun new_inner_var______ (definition : Definition.t) : Flambda.specialised_to -> ()) + foo +;; + +let new_specialised_args = + Variable.Map.mapi + (fun new_inner_var______ (definition : Definition.t) : Flambda.specialised_to -> ()) +;; diff --git a/test/passing/refs.janestreet/break_fun_decl-wrap.ml.ref b/test/passing/refs.janestreet/break_fun_decl-wrap.ml.ref new file mode 100644 index 0000000000..cc2dd6743c --- /dev/null +++ b/test/passing/refs.janestreet/break_fun_decl-wrap.ml.ref @@ -0,0 +1,158 @@ +class t = + object + method meth + aaaaaaaaaaa + bbbbbbbbbbbbbb + ccccccccccccccccccc + ddddddddddddddddddddd + eeeeeeeeeeeeeee = + body + end + +let func + aaaaaaaaaaa + bbbbbbbbbbbbbb + ccccccccccccccccccc + ddddddddddddddddddddd + eeeeeeeeeeeeeee + = + body +;; + +let rec func + aaaaaaaaaaa + bbbbbbbbbbbbbb + ccccccccccccccccccc + ddddddddddddddddddddd + eeeeeeeeeeeeeee + = + body +;; + +let ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc + = + g +;; + +let ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc + dddddddddddddddddddddd + = + g +;; + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc = g + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc dddddddddddddddddddddd = g + +let ffffffffffffffffffff : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb -> cccccccccccccccccccccc + = + g +;; + +let ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd + = + g +;; + +let fffffffffffffffffffffffffffffffffff x yyyyyyyyyyyyyyyyyyyyyyyyyyy = () + +let fffffffffffffffffffffffffffffffffff + x + yyyyyyyyyyyyyyyyyyyyyyyyyyy + yyyyyyyyyyyyyyyyyyyyyyyyyyy + = + () +;; + +class ffffffffffffffffffff = + object + method ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd = + g + + val ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd = + g + end + +class type ffffffffffffffffffff = object + method ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd + + val ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd + + val ffffffffffffffffffff : + (aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd) + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd +end + +let _ = + fun (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) -> + body +;; + +let _ = + f + (fun + (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) + -> body) +;; + +let f + (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) + = + body +;; + +(* Inconsistent formatting of fun arguments. *) + +let new_specialised_args = + Variable.Map.mapi + (fun new_inner_var______ (definition : Definition.t) : Flambda.specialised_to -> ()) + foo +;; + +let new_specialised_args = + Variable.Map.mapi + (fun new_inner_var______ (definition : Definition.t) : Flambda.specialised_to -> ()) +;; diff --git a/test/passing/refs.janestreet/break_fun_decl.ml.ref b/test/passing/refs.janestreet/break_fun_decl.ml.ref new file mode 100644 index 0000000000..e4c8ccd1eb --- /dev/null +++ b/test/passing/refs.janestreet/break_fun_decl.ml.ref @@ -0,0 +1,163 @@ +class t = + object + method meth + aaaaaaaaaaa + bbbbbbbbbbbbbb + ccccccccccccccccccc + ddddddddddddddddddddd + eeeeeeeeeeeeeee = + body + end + +let func + aaaaaaaaaaa + bbbbbbbbbbbbbb + ccccccccccccccccccc + ddddddddddddddddddddd + eeeeeeeeeeeeeee + = + body +;; + +let rec func + aaaaaaaaaaa + bbbbbbbbbbbbbb + ccccccccccccccccccc + ddddddddddddddddddddd + eeeeeeeeeeeeeee + = + body +;; + +let ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc + = + g +;; + +let ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc + dddddddddddddddddddddd + = + g +;; + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +class ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc = g + +class ffffffffffffffffffff + aaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc + dddddddddddddddddddddd = g + +let ffffffffffffffffffff : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb -> cccccccccccccccccccccc + = + g +;; + +let ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd + = + g +;; + +let fffffffffffffffffffffffffffffffffff x yyyyyyyyyyyyyyyyyyyyyyyyyyy = () + +let fffffffffffffffffffffffffffffffffff + x + yyyyyyyyyyyyyyyyyyyyyyyyyyy + yyyyyyyyyyyyyyyyyyyyyyyyyyy + = + () +;; + +class ffffffffffffffffffff = + object + method ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd = + g + + val ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd = + g + end + +class type ffffffffffffffffffff = object + method ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd + + val ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd + + val ffffffffffffffffffff : + (aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd) + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd +end + +let _ = + fun (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) -> + body +;; + +let _ = + f + (fun + (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) + -> body) +;; + +let f + (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) + = + body +;; + +(* Inconsistent formatting of fun arguments. *) + +let new_specialised_args = + Variable.Map.mapi + (fun new_inner_var______ (definition : Definition.t) : Flambda.specialised_to -> ()) + foo +;; + +let new_specialised_args = + Variable.Map.mapi + (fun new_inner_var______ (definition : Definition.t) : Flambda.specialised_to -> ()) +;; diff --git a/test/passing/refs.janestreet/break_infix-fit-or-vertical.ml.ref b/test/passing/refs.janestreet/break_infix-fit-or-vertical.ml.ref new file mode 100644 index 0000000000..058b64cc65 --- /dev/null +++ b/test/passing/refs.janestreet/break_infix-fit-or-vertical.ml.ref @@ -0,0 +1,110 @@ +let _ = + get_succs parent + |> Sequence.of_list + |> Sequence.filter ~f:(fun n -> not (equal node n)) + |> Sequence.Generator.of_sequence +;; + +let git_clone ~branch ~remote ~output_dir = + run_and_log + Cmd.( + v "git" % "clone" % "--depth" % "1" % "--branch" % branch % remote % p output_dir) +;; + +let all_6_2char_hex a b c d e f = + is_2char_hex a + && is_2char_hex b + && is_2char_hex c + && is_2char_hex d + && is_2char_hex e + && is_2char_hex f +;; + +let pf0 = + let open Utils.Parallel_folders in + open_ construct + |+ misc_stats_folder header + |+ elapsed_wall_over_blocks_folder header block_count + |+ elapsed_cpu_over_blocks_folder header block_count + |+ Span_folder.create header.initial_stats.timestamp_wall block_count + |+ cpu_usage_folder header block_count + |+ (pack_folder + && foooooooooooooooooooo + && foooooooooooooooooooo + && foooooooooooooooooooo) + |+ tree_folder @ foooooooooooooooooooo @ foooooooooooooooooooo @ foooooooooooooooooooo + |+ index_folder + foooooooooooooooooooo + foooooooooooooooooooo + foooooooooooooooooooo + |+ gc_folder * foooooooooooooooooooo * foooooooooooooooooooo * foooooooooooooooooooo + |+ disk_folder + |> seal +;; + +let cmd = root ^ ("_build" / "default" / Fmt.str "%s serve %d %d &" Sys.argv.(0) i id.id) + +let _ = + a b c + :: fooo fooooooooo fooo + :: x y zzzzzzz + :: ("aaa" ^ "bbb" ^ "cccccc" ^ "dddddddddd" ^ "eeeeeeeeeeeeee" ^ "ffffffffffffff") + :: foooooo + :: [ ffffffffff; ooooooooo ] +;; + +let _ = + fooooooooo + @@ fooooooooooooooo + @@ (fun x -> foooooooooooooo $ fooooooooooooooooooooo) + @@ fun x -> + fooooooooooooooo + $ fooooooooooooooooo + $ fooooooooooooooooo + $ fooooooooooooo + $ fooo @@ foooooooooooooooooo + $ fooooooooooooo + $ foooooooooooooooooooo +;; + +let _ = a + (b * c) + d + +let _ = + a + (b * c) + d + (b * c) + d + (b * c) + d + (b * c) + d + (b * c) + (b * c) + (b * c) +;; + +(* Break infix if followed by let or letop *) + +let term = + Term.ret + @@ let+ config = Common.config_term + and+ mode = + Arg.( + value + & pos 0 (some (enum modes)) None + & info + [] + ~docv:"ACTION" + ~doc: + (Printf.sprintf + "The cache-daemon action to perform (%s)" + (Arg.doc_alts_enum modes))) + in + config, mode +;; + +let term = + Term.ret + @@ + let config = Common.config_term + and mode = + Arg.( + value + & pos 0 (some (enum modes)) None + & info + [] + ~docv:"ACTION" + ~doc: + (Printf.sprintf + "The cache-daemon action to perform (%s)" + (Arg.doc_alts_enum modes))) + in + config, mode +;; diff --git a/test/passing/refs.janestreet/break_infix-wrap.ml.ref b/test/passing/refs.janestreet/break_infix-wrap.ml.ref new file mode 100644 index 0000000000..b2b00f6d5d --- /dev/null +++ b/test/passing/refs.janestreet/break_infix-wrap.ml.ref @@ -0,0 +1,92 @@ +let _ = + get_succs parent |> Sequence.of_list + |> Sequence.filter ~f:(fun n -> not (equal node n)) + |> Sequence.Generator.of_sequence +;; + +let git_clone ~branch ~remote ~output_dir = + run_and_log + Cmd.( + v "git" % "clone" % "--depth" % "1" % "--branch" % branch % remote % p output_dir) +;; + +let all_6_2char_hex a b c d e f = + is_2char_hex a && is_2char_hex b && is_2char_hex c && is_2char_hex d && is_2char_hex e + && is_2char_hex f +;; + +let pf0 = + let open Utils.Parallel_folders in + open_ construct |+ misc_stats_folder header + |+ elapsed_wall_over_blocks_folder header block_count + |+ elapsed_cpu_over_blocks_folder header block_count + |+ Span_folder.create header.initial_stats.timestamp_wall block_count + |+ cpu_usage_folder header block_count + |+ (pack_folder && foooooooooooooooooooo && foooooooooooooooooooo + && foooooooooooooooooooo) + |+ tree_folder @ foooooooooooooooooooo @ foooooooooooooooooooo @ foooooooooooooooooooo + |+ index_folder + foooooooooooooooooooo + foooooooooooooooooooo + foooooooooooooooooooo + |+ gc_folder * foooooooooooooooooooo * foooooooooooooooooooo * foooooooooooooooooooo + |+ disk_folder |> seal +;; + +let cmd = root ^ ("_build" / "default" / Fmt.str "%s serve %d %d &" Sys.argv.(0) i id.id) + +let _ = + a b c :: fooo fooooooooo fooo :: x y zzzzzzz + :: ("aaa" ^ "bbb" ^ "cccccc" ^ "dddddddddd" ^ "eeeeeeeeeeeeee" ^ "ffffffffffffff") + :: foooooo :: [ ffffffffff; ooooooooo ] +;; + +let _ = + fooooooooo @@ fooooooooooooooo + @@ (fun x -> foooooooooooooo $ fooooooooooooooooooooo) + @@ fun x -> + fooooooooooooooo $ fooooooooooooooooo $ fooooooooooooooooo $ fooooooooooooo + $ fooo @@ foooooooooooooooooo $ fooooooooooooo $ foooooooooooooooooooo +;; + +let _ = a + (b * c) + d + +let _ = + a + (b * c) + d + (b * c) + d + (b * c) + d + (b * c) + d + (b * c) + (b * c) + (b * c) +;; + +(* Break infix if followed by let or letop *) + +let term = + Term.ret + @@ let+ config = Common.config_term + and+ mode = + Arg.( + value + & pos 0 (some (enum modes)) None + & info + [] + ~docv:"ACTION" + ~doc: + (Printf.sprintf + "The cache-daemon action to perform (%s)" + (Arg.doc_alts_enum modes))) + in + config, mode +;; + +let term = + Term.ret + @@ + let config = Common.config_term + and mode = + Arg.( + value + & pos 0 (some (enum modes)) None + & info + [] + ~docv:"ACTION" + ~doc: + (Printf.sprintf + "The cache-daemon action to perform (%s)" + (Arg.doc_alts_enum modes))) + in + config, mode +;; diff --git a/test/passing/refs.janestreet/break_infix.ml.ref b/test/passing/refs.janestreet/break_infix.ml.ref new file mode 100644 index 0000000000..97ab71d4bb --- /dev/null +++ b/test/passing/refs.janestreet/break_infix.ml.ref @@ -0,0 +1,109 @@ +let _ = + get_succs parent + |> Sequence.of_list + |> Sequence.filter ~f:(fun n -> not (equal node n)) + |> Sequence.Generator.of_sequence +;; + +let git_clone ~branch ~remote ~output_dir = + run_and_log + Cmd.( + v "git" % "clone" % "--depth" % "1" % "--branch" % branch % remote % p output_dir) +;; + +let all_6_2char_hex a b c d e f = + is_2char_hex a + && is_2char_hex b + && is_2char_hex c + && is_2char_hex d + && is_2char_hex e + && is_2char_hex f +;; + +let pf0 = + let open Utils.Parallel_folders in + open_ construct + |+ misc_stats_folder header + |+ elapsed_wall_over_blocks_folder header block_count + |+ elapsed_cpu_over_blocks_folder header block_count + |+ Span_folder.create header.initial_stats.timestamp_wall block_count + |+ cpu_usage_folder header block_count + |+ (pack_folder + && foooooooooooooooooooo + && foooooooooooooooooooo + && foooooooooooooooooooo) + |+ tree_folder @ foooooooooooooooooooo @ foooooooooooooooooooo @ foooooooooooooooooooo + |+ index_folder + foooooooooooooooooooo + foooooooooooooooooooo + foooooooooooooooooooo + |+ gc_folder * foooooooooooooooooooo * foooooooooooooooooooo * foooooooooooooooooooo + |+ disk_folder + |> seal +;; + +let cmd = root ^ ("_build" / "default" / Fmt.str "%s serve %d %d &" Sys.argv.(0) i id.id) + +let _ = + a b c + :: fooo fooooooooo fooo + :: x y zzzzzzz + :: ("aaa" ^ "bbb" ^ "cccccc" ^ "dddddddddd" ^ "eeeeeeeeeeeeee" ^ "ffffffffffffff") + :: foooooo + :: [ ffffffffff; ooooooooo ] +;; + +let _ = + fooooooooo @@ fooooooooooooooo + @@ (fun x -> foooooooooooooo $ fooooooooooooooooooooo) + @@ fun x -> + fooooooooooooooo + $ fooooooooooooooooo + $ fooooooooooooooooo + $ fooooooooooooo + $ fooo @@ foooooooooooooooooo + $ fooooooooooooo + $ foooooooooooooooooooo +;; + +let _ = a + (b * c) + d + +let _ = + a + (b * c) + d + (b * c) + d + (b * c) + d + (b * c) + d + (b * c) + (b * c) + (b * c) +;; + +(* Break infix if followed by let or letop *) + +let term = + Term.ret + @@ let+ config = Common.config_term + and+ mode = + Arg.( + value + & pos 0 (some (enum modes)) None + & info + [] + ~docv:"ACTION" + ~doc: + (Printf.sprintf + "The cache-daemon action to perform (%s)" + (Arg.doc_alts_enum modes))) + in + config, mode +;; + +let term = + Term.ret + @@ + let config = Common.config_term + and mode = + Arg.( + value + & pos 0 (some (enum modes)) None + & info + [] + ~docv:"ACTION" + ~doc: + (Printf.sprintf + "The cache-daemon action to perform (%s)" + (Arg.doc_alts_enum modes))) + in + config, mode +;; diff --git a/test/passing/refs.janestreet/break_record.ml.ref b/test/passing/refs.janestreet/break_record.ml.ref new file mode 100644 index 0000000000..193ed59bdd --- /dev/null +++ b/test/passing/refs.janestreet/break_record.ml.ref @@ -0,0 +1,6 @@ +let xxxxxxxxxxxxxxxxxxxxxx x = + { xxxxxxxxxxxxxx + ; xxxxxxxxxxxxxxxxxx = x + ; xxxxxxxxxxxxx + } +;; diff --git a/test/passing/refs.janestreet/break_separators-after.ml.ref b/test/passing/refs.janestreet/break_separators-after.ml.ref new file mode 100644 index 0000000000..f22bb2574b --- /dev/null +++ b/test/passing/refs.janestreet/break_separators-after.ml.ref @@ -0,0 +1,410 @@ +type t = + { (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooo : foooooooooooooooooooooooooooooooooooooooo; + (* foooooooooooooooooooooooooooooooooooooooooooo *) + fooooooooooooooooooooooooooooo : fooooooooooooooooooooooooooo + } + +type x = + | B of + { (* fooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaa; + (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbbbbb + } + +type t = + { aaaaaaaaaaaaaaaaaaaaaaaaa : aaaa aaaaaaaaaaaaaaaaaaa; + bbbbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbb bbbb; + cccccccccccccccccccccc : ccccccc ccccccccccc cccccccc + } + +type x = + | B of + { aaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaa; + bbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbbbbb + } + +type t = + { break_cases : [ `Fit | `Nested | `All ]; + break_collection_expressions : [ `Wrap | `Fit_or_vertical ]; + break_infix : [ `Wrap | `Fit_or_vertical ]; + break_separators : bool; + break_sequences : bool; + break_string_literals : [ `Newlines | `Never | `Wrap ]; + (** How to potentially break string literals into new lines. *) + break_struct : bool; + cases_exp_indent : int; + comment_check : bool; + disable : bool; + doc_comments : [ `Before | `After ]; + escape_chars : [ `Decimal | `Hexadecimal | `Preserve ]; + (** Escape encoding for chars literals. *) + escape_strings : [ `Decimal | `Hexadecimal | `Preserve ]; + (** Escape encoding for string literals. *) + extension_sugar : [ `Preserve | `Always ]; + field_space : [ `Tight | `Loose ]; + if_then_else : [ `Compact | `Keyword_first ]; + indicate_multiline_delimiters : bool; + indicate_nested_or_patterns : bool; + infix_precedence : [ `Indent | `Parens ]; + leading_nested_match_parens : bool; + let_and : [ `Compact | `Sparse ]; + let_binding_spacing : [ `Compact | `Sparse | `Double_semicolon ]; + let_open : [ `Preserve | `Auto | `Short | `Long ]; + margin : int; (** Format code to fit within [margin] columns. *) + max_iters : int; + (** Fail if output of formatting does not stabilize within + [max_iters] iterations. *) + module_item_spacing : [ `Compact | `Sparse ]; + ocp_indent_compat : bool; (** Try to indent like ocp-indent *) + parens_ite : bool; + parens_tuple : [ `Always | `Multi_line_only ]; + parens_tuple_patterns : [ `Always | `Multi_line_only ]; + parse_docstrings : bool; + quiet : bool; + sequence_style : [ `Separator | `Terminator ]; + single_case : [ `Compact | `Sparse ]; + type_decl : [ `Compact | `Sparse ]; + wrap_comments : bool; (** Wrap comments at margin. *) + wrap_fun_args : bool + } + +let _ = + match something with + | { very_very_long_field_name_running_out_of_space = 1; + another_very_very_long_field_name_running_out_of_space = 2; + _ + } -> 0 + | _ -> 1 +;; + +let _ = + match something with + | [ very_very_long_field_name_running_out_of_space; + another_very_very_long_field_name_running_out_of_space; + _ + ] -> 0 + | _ -> 1 +;; + +let _ = + match something with + | [| very_very_long_field_name_running_out_of_space; + another_very_very_long_field_name_running_out_of_space; + _ + |] -> 0 + | _ -> 1 +;; + +[@@@ocamlformat "type-decl=compact"] + +type t = { aaaaaaaaa : aaaa; bbbbbbbbb : bbbb } +type trace_mod_funs = { trace_mod : bool option; trace_funs : bool Map.M(String).t } + +[@@@ocamlformat "type-decl=sparse"] + +module X = struct + val select + : (* The fsevents context *) + env -> + (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list -> + (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list -> + (* Timeout...like Unix.select *) + timeout:float -> + (* The callback for file system events *) + (event list -> unit) -> + unit +end + +type t = + { aaaaaaaaa : aaaa; + bbbbbbbbb : bbbb + } + +type trace_mod_funs = + { trace_mod : bool option; + trace_funs : bool Map.M(String).t + } + +let x { aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa } = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb = bbb bb bbbbbb } +;; + +let x + { aaaaaaaaaaaaaaaaaaaaaa; + aaaaaaaaaaaaaaaaaaa; + aaaaaaaaaaaaaa; + aaaaaaaaaaaaaaaaaa; + aaaaaaaaaa + } + = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; + bbbbbbbbbbbbb = bbb bb bbbbbb; + cccccc = cccc ccccccccccccccccccccccc + } +;; + +(* this is an array *) +let length = + [| 0; + 269999999999999999999999999999999999999999999999999; + 26; + (* foo *) 27 (* foo *); + 27; + 27 + |] + [@foo] +;; + +(* this is a list *) +let length = + [ 0; 14; (* foo *) 14; 17 (* foo *); 17; 2777777777777777777777777777777777; 27 ] [@foo] +;; + +Fooooooo.foo + ~foooooooooooooo + ~fooooooooo:"" + (Foo.foo + ~foo + ~foo + ~foooo:() + [ "fooooo", Foo.fooo ~foooo ~foooo:(foooo >*> fooooo); + "foooo", fooooooo; + "foooooo", foooooooo; + "fooooooooo", foooooooo + ]) + +class + ['aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb] x = + ['xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 'yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy] k + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb) e + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ('aaaaaaaaa, 'bbbbbbbbbbbb) e + +let ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, + yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy, + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz, + (aaaaaaaaaaaa, bbbbbbbbbbbb) ) + = + ( ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, + yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy, + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz ), + (aaaaaaaaaaaaaa, bbbbbbbbbbbb) ) +;; + +type t = aaaaaaaaaaaa -> bbbbbbbbbbbb -> cccccccccc + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb -> + ccccccccccccccccccccccccc + +type t = + (* foooooooooooo *) + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + (* foooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb -> + (* fooooooooooooooooo *) + ccccccccccccccccccccccccc -> + (* foooooo *) + foo * [ `Foo of foo * foo ] -> + (* foooooooooooooooo *) + foo + * foo + * foo + * foo + * [ `Foo of + (* fooooooooooooooooooo *) + foo * foo * foo -> + foo -> + foo -> + (* foooooooooooo *) + foo -> + foo -> + foo * foo -> + foo * foo -> + foo * foo + ] -> + (* foooooooooooooooo *) + fooooooooooooooooo + +type t = + { (* fooooooooooooooooo *) + foo : foo; + (* foooooooooooooooooooooo fooooooooooooooooooo fooooooooooooooo + foooooooooooooooooo foooooooooooooooo *) + foo : + (* fooooooooooooooooooo *) + foooooooooooo -> + (* foooooooooooooo *) + foooooooooooooooo -> + foooooooooooooo -> + foooooooooo -> + fooooooooooooooo; + foo : foo + } + +[@@@ocamlformat "ocp-indent-compat"] + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb -> + ccccccccccccccccccccccccc + +type t = + (string Location.loc * payload) list -> + (string Location.loc * bool) list option * (string Location.loc * payload) list -> + (string Location.loc * bool) list option * (string Location.loc * payload) list -> + (string Location.loc * bool) list option * (string Location.loc * payload) list + +let x { aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa } = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb = bbb bb bbbbbb } +;; + +let x + { aaaaaaaaaaaaaaaaaaaaaa; + aaaaaaaaaaaaaaaaaaa; + aaaaaaaaaaaaaa; + aaaaaaaaaaaaaaaaaa; + aaaaaaaaaa + } + = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; + bbbbbbbbbbbbb = bbb bb bbbbbb; + cccccc = cccc ccccccccccccccccccccccc + } +;; + +let foooooooooooooooooooooooooooooooooo = + { (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; + (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + bbbbbbbbbbbbb = bbb bb bbbbbb; + cccccc = cccc ccccccccccccccccccccccc + } +;; + +let foooooooooooo = + { foooooooooooooo with + fooooooooooooooooooooooooooooo = fooooooooooooo; + fooooooooooooo = foooooooooooooo + } +;; + +let foooooooooooo = + { foooooooooooooo with + (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo + *) + fooooooooooooooooooooooooooooo = fooooooooooooo; + fooooooooooooo = foooooooooooooo + } +;; + +let fooooooooooo = function + | Pmty_alias lid -> + { empty with + bdy = fmt_longident_loc c lid; + epi = Some (fmt_attributes c ~key:"@" pmty_attributes ~pre:(fmt "@ ")) + } +;; + +let f () = + let { aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh + } + = + some_value + in + foooooooooooo +;; + +let f () = + let [ aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh + ] + = + some_value + in + foooooooooooo +;; + +let f () = + let [| aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh + |] + = + some_value + in + foooooooooooo +;; + +let g () = + match some_value with + | { aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh + } -> foooooooo + | [ aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh + ] -> fooooooooo + | [| aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh + |] -> fooooooooo +;; + +let () = + match x with + | ( _, + (* line 1 line 2 *) + Some _ ) -> x +;; + +let () = + match x with + | ( _, + (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1 + veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 + *) + Some _ ) -> x +;; diff --git a/test/passing/refs.janestreet/break_separators-after_docked.ml.ref b/test/passing/refs.janestreet/break_separators-after_docked.ml.ref new file mode 100644 index 0000000000..6b2d1ee726 --- /dev/null +++ b/test/passing/refs.janestreet/break_separators-after_docked.ml.ref @@ -0,0 +1,429 @@ +type t = { + (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooo : foooooooooooooooooooooooooooooooooooooooo; + (* foooooooooooooooooooooooooooooooooooooooooooo *) + fooooooooooooooooooooooooooooo : fooooooooooooooooooooooooooo; +} + +type x = + | B of { + (* fooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaa; + (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbbbbb; + } + +type t = { + aaaaaaaaaaaaaaaaaaaaaaaaa : aaaa aaaaaaaaaaaaaaaaaaa; + bbbbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbb bbbb; + cccccccccccccccccccccc : ccccccc ccccccccccc cccccccc; +} + +type x = + | B of { + aaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaa; + bbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbbbbb; + } + +type t = { + break_cases : [ `Fit | `Nested | `All ]; + break_collection_expressions : [ `Wrap | `Fit_or_vertical ]; + break_infix : [ `Wrap | `Fit_or_vertical ]; + break_separators : bool; + break_sequences : bool; + break_string_literals : [ `Newlines | `Never | `Wrap ]; + (** How to potentially break string literals into new lines. *) + break_struct : bool; + cases_exp_indent : int; + comment_check : bool; + disable : bool; + doc_comments : [ `Before | `After ]; + escape_chars : [ `Decimal | `Hexadecimal | `Preserve ]; + (** Escape encoding for chars literals. *) + escape_strings : [ `Decimal | `Hexadecimal | `Preserve ]; + (** Escape encoding for string literals. *) + extension_sugar : [ `Preserve | `Always ]; + field_space : [ `Tight | `Loose ]; + if_then_else : [ `Compact | `Keyword_first ]; + indicate_multiline_delimiters : bool; + indicate_nested_or_patterns : bool; + infix_precedence : [ `Indent | `Parens ]; + leading_nested_match_parens : bool; + let_and : [ `Compact | `Sparse ]; + let_binding_spacing : [ `Compact | `Sparse | `Double_semicolon ]; + let_open : [ `Preserve | `Auto | `Short | `Long ]; + margin : int; (** Format code to fit within [margin] columns. *) + max_iters : int; + (** Fail if output of formatting does not stabilize within + [max_iters] iterations. *) + module_item_spacing : [ `Compact | `Sparse ]; + ocp_indent_compat : bool; (** Try to indent like ocp-indent *) + parens_ite : bool; + parens_tuple : [ `Always | `Multi_line_only ]; + parens_tuple_patterns : [ `Always | `Multi_line_only ]; + parse_docstrings : bool; + quiet : bool; + sequence_style : [ `Separator | `Terminator ]; + single_case : [ `Compact | `Sparse ]; + type_decl : [ `Compact | `Sparse ]; + wrap_comments : bool; (** Wrap comments at margin. *) + wrap_fun_args : bool; +} + +let _ = + match something with + | { + very_very_long_field_name_running_out_of_space = 1; + another_very_very_long_field_name_running_out_of_space = 2; + _; + } -> 0 + | _ -> 1 +;; + +let _ = + match something with + | [ + very_very_long_field_name_running_out_of_space; + another_very_very_long_field_name_running_out_of_space; + _; + ] -> 0 + | _ -> 1 +;; + +let _ = + match something with + | [| + very_very_long_field_name_running_out_of_space; + another_very_very_long_field_name_running_out_of_space; + _; + |] -> 0 + | _ -> 1 +;; + +[@@@ocamlformat "type-decl=compact"] + +type t = { aaaaaaaaa : aaaa; bbbbbbbbb : bbbb } +type trace_mod_funs = { trace_mod : bool option; trace_funs : bool Map.M(String).t } + +[@@@ocamlformat "type-decl=sparse"] + +module X = struct + val select + : (* The fsevents context *) + env -> + (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list -> + (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list -> + (* Timeout...like Unix.select *) + timeout:float -> + (* The callback for file system events *) + (event list -> unit) -> + unit +end + +type t = { + aaaaaaaaa : aaaa; + bbbbbbbbb : bbbb; +} + +type trace_mod_funs = { + trace_mod : bool option; + trace_funs : bool Map.M(String).t; +} + +let x { aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa } = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb = bbb bb bbbbbb } +;; + +let x + { + aaaaaaaaaaaaaaaaaaaaaa; + aaaaaaaaaaaaaaaaaaa; + aaaaaaaaaaaaaa; + aaaaaaaaaaaaaaaaaa; + aaaaaaaaaa; + } + = + { + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; + bbbbbbbbbbbbb = bbb bb bbbbbb; + cccccc = cccc ccccccccccccccccccccccc; + } +;; + +(* this is an array *) +let length = + [| + 0; + 269999999999999999999999999999999999999999999999999; + 26; + (* foo *) 27 (* foo *); + 27; + 27; + |] + [@foo] +;; + +(* this is a list *) +let length = + [ 0; 14; (* foo *) 14; 17 (* foo *); 17; 2777777777777777777777777777777777; 27 ] [@foo] +;; + +Fooooooo.foo + ~foooooooooooooo + ~fooooooooo:"" + (Foo.foo + ~foo + ~foo + ~foooo:() + [ + "fooooo", Foo.fooo ~foooo ~foooo:(foooo >*> fooooo); + "foooo", fooooooo; + "foooooo", foooooooo; + "fooooooooo", foooooooo; + ]) + +class + ['aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb] x = + ['xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 'yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy] k + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb) e + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ('aaaaaaaaa, 'bbbbbbbbbbbb) e + +let ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, + yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy, + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz, + (aaaaaaaaaaaa, bbbbbbbbbbbb) ) + = + ( ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, + yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy, + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz ), + (aaaaaaaaaaaaaa, bbbbbbbbbbbb) ) +;; + +type t = aaaaaaaaaaaa -> bbbbbbbbbbbb -> cccccccccc + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb -> + ccccccccccccccccccccccccc + +type t = + (* foooooooooooo *) + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + (* foooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb -> + (* fooooooooooooooooo *) + ccccccccccccccccccccccccc -> + (* foooooo *) + foo * [ `Foo of foo * foo ] -> + (* foooooooooooooooo *) + foo + * foo + * foo + * foo + * [ `Foo of + (* fooooooooooooooooooo *) + foo * foo * foo -> + foo -> + foo -> + (* foooooooooooo *) + foo -> + foo -> + foo * foo -> + foo * foo -> + foo * foo + ] -> + (* foooooooooooooooo *) + fooooooooooooooooo + +type t = { + (* fooooooooooooooooo *) + foo : foo; + (* foooooooooooooooooooooo fooooooooooooooooooo fooooooooooooooo + foooooooooooooooooo foooooooooooooooo *) + foo : + (* fooooooooooooooooooo *) + foooooooooooo -> + (* foooooooooooooo *) + foooooooooooooooo -> + foooooooooooooo -> + foooooooooo -> + fooooooooooooooo; + foo : foo; +} + +[@@@ocamlformat "ocp-indent-compat"] + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb -> + ccccccccccccccccccccccccc + +type t = + (string Location.loc * payload) list -> + (string Location.loc * bool) list option * (string Location.loc * payload) list -> + (string Location.loc * bool) list option * (string Location.loc * payload) list -> + (string Location.loc * bool) list option * (string Location.loc * payload) list + +let x { aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa } = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb = bbb bb bbbbbb } +;; + +let x + { + aaaaaaaaaaaaaaaaaaaaaa; + aaaaaaaaaaaaaaaaaaa; + aaaaaaaaaaaaaa; + aaaaaaaaaaaaaaaaaa; + aaaaaaaaaa; + } + = + { + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; + bbbbbbbbbbbbb = bbb bb bbbbbb; + cccccc = cccc ccccccccccccccccccccccc; + } +;; + +let foooooooooooooooooooooooooooooooooo = + { + (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; + (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + bbbbbbbbbbbbb = bbb bb bbbbbb; + cccccc = cccc ccccccccccccccccccccccc; + } +;; + +let foooooooooooo = + { + foooooooooooooo with + fooooooooooooooooooooooooooooo = fooooooooooooo; + fooooooooooooo = foooooooooooooo; + } +;; + +let foooooooooooo = + { + foooooooooooooo with + (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo + *) + fooooooooooooooooooooooooooooo = fooooooooooooo; + fooooooooooooo = foooooooooooooo; + } +;; + +let fooooooooooo = function + | Pmty_alias lid -> + { + empty with + bdy = fmt_longident_loc c lid; + epi = Some (fmt_attributes c ~key:"@" pmty_attributes ~pre:(fmt "@ ")); + } +;; + +let f () = + let { + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + } + = + some_value + in + foooooooooooo +;; + +let f () = + let [ + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + ] + = + some_value + in + foooooooooooo +;; + +let f () = + let [| + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + |] + = + some_value + in + foooooooooooo +;; + +let g () = + match some_value with + | { + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + } -> foooooooo + | [ + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + ] -> fooooooooo + | [| + aaaaaaaa; + bbbbbbbbbb; + ccccccccc; + dddddddddd; + eeeeeeeee; + ffffffffff; + gggggggggg; + hhhhhhhhhh; + |] -> fooooooooo +;; + +let () = + match x with + | ( _, + (* line 1 line 2 *) + Some _ ) -> x +;; + +let () = + match x with + | ( _, + (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1 + veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 + *) + Some _ ) -> x +;; diff --git a/test/passing/refs.janestreet/break_separators-before_docked.ml.ref b/test/passing/refs.janestreet/break_separators-before_docked.ml.ref new file mode 100644 index 0000000000..c27ea402e9 --- /dev/null +++ b/test/passing/refs.janestreet/break_separators-before_docked.ml.ref @@ -0,0 +1,429 @@ +type t = { + (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooo : foooooooooooooooooooooooooooooooooooooooo + ; (* foooooooooooooooooooooooooooooooooooooooooooo *) + fooooooooooooooooooooooooooooo : fooooooooooooooooooooooooooo +} + +type x = + | B of { + (* fooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaa + ; (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbbbbb + } + +type t = { + aaaaaaaaaaaaaaaaaaaaaaaaa : aaaa aaaaaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbb bbbb + ; cccccccccccccccccccccc : ccccccc ccccccccccc cccccccc +} + +type x = + | B of { + aaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbbbbb + } + +type t = { + break_cases : [ `Fit | `Nested | `All ] + ; break_collection_expressions : [ `Wrap | `Fit_or_vertical ] + ; break_infix : [ `Wrap | `Fit_or_vertical ] + ; break_separators : bool + ; break_sequences : bool + ; break_string_literals : [ `Newlines | `Never | `Wrap ] + (** How to potentially break string literals into new lines. *) + ; break_struct : bool + ; cases_exp_indent : int + ; comment_check : bool + ; disable : bool + ; doc_comments : [ `Before | `After ] + ; escape_chars : [ `Decimal | `Hexadecimal | `Preserve ] + (** Escape encoding for chars literals. *) + ; escape_strings : [ `Decimal | `Hexadecimal | `Preserve ] + (** Escape encoding for string literals. *) + ; extension_sugar : [ `Preserve | `Always ] + ; field_space : [ `Tight | `Loose ] + ; if_then_else : [ `Compact | `Keyword_first ] + ; indicate_multiline_delimiters : bool + ; indicate_nested_or_patterns : bool + ; infix_precedence : [ `Indent | `Parens ] + ; leading_nested_match_parens : bool + ; let_and : [ `Compact | `Sparse ] + ; let_binding_spacing : [ `Compact | `Sparse | `Double_semicolon ] + ; let_open : [ `Preserve | `Auto | `Short | `Long ] + ; margin : int (** Format code to fit within [margin] columns. *) + ; max_iters : int + (** Fail if output of formatting does not stabilize within + [max_iters] iterations. *) + ; module_item_spacing : [ `Compact | `Sparse ] + ; ocp_indent_compat : bool (** Try to indent like ocp-indent *) + ; parens_ite : bool + ; parens_tuple : [ `Always | `Multi_line_only ] + ; parens_tuple_patterns : [ `Always | `Multi_line_only ] + ; parse_docstrings : bool + ; quiet : bool + ; sequence_style : [ `Separator | `Terminator ] + ; single_case : [ `Compact | `Sparse ] + ; type_decl : [ `Compact | `Sparse ] + ; wrap_comments : bool (** Wrap comments at margin. *) + ; wrap_fun_args : bool +} + +let _ = + match something with + | { + very_very_long_field_name_running_out_of_space = 1 + ; another_very_very_long_field_name_running_out_of_space = 2 + ; _ + } -> 0 + | _ -> 1 +;; + +let _ = + match something with + | [ + very_very_long_field_name_running_out_of_space + ; another_very_very_long_field_name_running_out_of_space + ; _ + ] -> 0 + | _ -> 1 +;; + +let _ = + match something with + | [| + very_very_long_field_name_running_out_of_space + ; another_very_very_long_field_name_running_out_of_space + ; _ + |] -> 0 + | _ -> 1 +;; + +[@@@ocamlformat "type-decl=compact"] + +type t = { aaaaaaaaa : aaaa; bbbbbbbbb : bbbb } +type trace_mod_funs = { trace_mod : bool option; trace_funs : bool Map.M(String).t } + +[@@@ocamlformat "type-decl=sparse"] + +module X = struct + val select + : (* The fsevents context *) + env + -> (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list + -> (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list + -> (* Timeout...like Unix.select *) + timeout:float + -> (* The callback for file system events *) + (event list -> unit) + -> unit +end + +type t = { + aaaaaaaaa : aaaa + ; bbbbbbbbb : bbbb +} + +type trace_mod_funs = { + trace_mod : bool option + ; trace_funs : bool Map.M(String).t +} + +let x { aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa } = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb = bbb bb bbbbbb } +;; + +let x + { + aaaaaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaa + ; aaaaaaaaaa + } + = + { + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbb = bbb bb bbbbbb + ; cccccc = cccc ccccccccccccccccccccccc + } +;; + +(* this is an array *) +let length = + [| + 0 + ; 269999999999999999999999999999999999999999999999999 + ; 26 + ; (* foo *) 27 (* foo *) + ; 27 + ; 27 + |] + [@foo] +;; + +(* this is a list *) +let length = + [ 0; 14; (* foo *) 14; 17 (* foo *); 17; 2777777777777777777777777777777777; 27 ] [@foo] +;; + +Fooooooo.foo + ~foooooooooooooo + ~fooooooooo:"" + (Foo.foo + ~foo + ~foo + ~foooo:() + [ + "fooooo", Foo.fooo ~foooo ~foooo:(foooo >*> fooooo) + ; "foooo", fooooooo + ; "foooooo", foooooooo + ; "fooooooooo", foooooooo + ]) + +class + ['aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb] x = + ['xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 'yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy] k + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb) e + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ('aaaaaaaaa, 'bbbbbbbbbbbb) e + +let ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + , yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy + , zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + , (aaaaaaaaaaaa, bbbbbbbbbbbb) ) + = + ( ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + , yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy + , zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz ) + , (aaaaaaaaaaaaaa, bbbbbbbbbbbb) ) +;; + +type t = aaaaaaaaaaaa -> bbbbbbbbbbbb -> cccccccccc + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + -> ccccccccccccccccccccccccc + +type t = + (* foooooooooooo *) + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + -> (* foooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + -> (* fooooooooooooooooo *) + ccccccccccccccccccccccccc + -> (* foooooo *) + foo * [ `Foo of foo * foo ] + -> (* foooooooooooooooo *) + foo + * foo + * foo + * foo + * [ `Foo of + (* fooooooooooooooooooo *) + foo * foo * foo + -> foo + -> foo + -> (* foooooooooooo *) + foo + -> foo + -> foo * foo + -> foo * foo + -> foo * foo + ] + -> (* foooooooooooooooo *) + fooooooooooooooooo + +type t = { + (* fooooooooooooooooo *) + foo : foo + ; (* foooooooooooooooooooooo fooooooooooooooooooo fooooooooooooooo + foooooooooooooooooo foooooooooooooooo *) + foo : + (* fooooooooooooooooooo *) + foooooooooooo + -> (* foooooooooooooo *) + foooooooooooooooo + -> foooooooooooooo + -> foooooooooo + -> fooooooooooooooo + ; foo : foo +} + +[@@@ocamlformat "ocp-indent-compat"] + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + -> ccccccccccccccccccccccccc + +type t = + (string Location.loc * payload) list + -> (string Location.loc * bool) list option * (string Location.loc * payload) list + -> (string Location.loc * bool) list option * (string Location.loc * payload) list + -> (string Location.loc * bool) list option * (string Location.loc * payload) list + +let x { aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa } = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb = bbb bb bbbbbb } +;; + +let x + { + aaaaaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaa + ; aaaaaaaaaa + } + = + { + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbb = bbb bb bbbbbb + ; cccccc = cccc ccccccccccccccccccccccc + } +;; + +let foooooooooooooooooooooooooooooooooo = + { + (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa + ; (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + bbbbbbbbbbbbb = bbb bb bbbbbb + ; cccccc = cccc ccccccccccccccccccccccc + } +;; + +let foooooooooooo = + { + foooooooooooooo with + fooooooooooooooooooooooooooooo = fooooooooooooo + ; fooooooooooooo = foooooooooooooo + } +;; + +let foooooooooooo = + { + foooooooooooooo with + (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo + *) + fooooooooooooooooooooooooooooo = fooooooooooooo + ; fooooooooooooo = foooooooooooooo + } +;; + +let fooooooooooo = function + | Pmty_alias lid -> + { + empty with + bdy = fmt_longident_loc c lid + ; epi = Some (fmt_attributes c ~key:"@" pmty_attributes ~pre:(fmt "@ ")) + } +;; + +let f () = + let { + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + } + = + some_value + in + foooooooooooo +;; + +let f () = + let [ + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + ] + = + some_value + in + foooooooooooo +;; + +let f () = + let [| + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + |] + = + some_value + in + foooooooooooo +;; + +let g () = + match some_value with + | { + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + } -> foooooooo + | [ + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + ] -> fooooooooo + | [| + aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + |] -> fooooooooo +;; + +let () = + match x with + | ( _ + , (* line 1 line 2 *) + Some _ ) -> x +;; + +let () = + match x with + | ( _ + , (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1 + veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 + *) + Some _ ) -> x +;; diff --git a/test/passing/refs.janestreet/break_separators.ml.ref b/test/passing/refs.janestreet/break_separators.ml.ref new file mode 100644 index 0000000000..692c520eb2 --- /dev/null +++ b/test/passing/refs.janestreet/break_separators.ml.ref @@ -0,0 +1,410 @@ +type t = + { (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooo : foooooooooooooooooooooooooooooooooooooooo + ; (* foooooooooooooooooooooooooooooooooooooooooooo *) + fooooooooooooooooooooooooooooo : fooooooooooooooooooooooooooo + } + +type x = + | B of + { (* fooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaa + ; (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbbbbb + } + +type t = + { aaaaaaaaaaaaaaaaaaaaaaaaa : aaaa aaaaaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbb bbbb + ; cccccccccccccccccccccc : ccccccc ccccccccccc cccccccc + } + +type x = + | B of + { aaaaaaaaaaaaaaa : aaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbbbbbbbbbbbb : bbbbbbbbbbbbbbb + } + +type t = + { break_cases : [ `Fit | `Nested | `All ] + ; break_collection_expressions : [ `Wrap | `Fit_or_vertical ] + ; break_infix : [ `Wrap | `Fit_or_vertical ] + ; break_separators : bool + ; break_sequences : bool + ; break_string_literals : [ `Newlines | `Never | `Wrap ] + (** How to potentially break string literals into new lines. *) + ; break_struct : bool + ; cases_exp_indent : int + ; comment_check : bool + ; disable : bool + ; doc_comments : [ `Before | `After ] + ; escape_chars : [ `Decimal | `Hexadecimal | `Preserve ] + (** Escape encoding for chars literals. *) + ; escape_strings : [ `Decimal | `Hexadecimal | `Preserve ] + (** Escape encoding for string literals. *) + ; extension_sugar : [ `Preserve | `Always ] + ; field_space : [ `Tight | `Loose ] + ; if_then_else : [ `Compact | `Keyword_first ] + ; indicate_multiline_delimiters : bool + ; indicate_nested_or_patterns : bool + ; infix_precedence : [ `Indent | `Parens ] + ; leading_nested_match_parens : bool + ; let_and : [ `Compact | `Sparse ] + ; let_binding_spacing : [ `Compact | `Sparse | `Double_semicolon ] + ; let_open : [ `Preserve | `Auto | `Short | `Long ] + ; margin : int (** Format code to fit within [margin] columns. *) + ; max_iters : int + (** Fail if output of formatting does not stabilize within + [max_iters] iterations. *) + ; module_item_spacing : [ `Compact | `Sparse ] + ; ocp_indent_compat : bool (** Try to indent like ocp-indent *) + ; parens_ite : bool + ; parens_tuple : [ `Always | `Multi_line_only ] + ; parens_tuple_patterns : [ `Always | `Multi_line_only ] + ; parse_docstrings : bool + ; quiet : bool + ; sequence_style : [ `Separator | `Terminator ] + ; single_case : [ `Compact | `Sparse ] + ; type_decl : [ `Compact | `Sparse ] + ; wrap_comments : bool (** Wrap comments at margin. *) + ; wrap_fun_args : bool + } + +let _ = + match something with + | { very_very_long_field_name_running_out_of_space = 1 + ; another_very_very_long_field_name_running_out_of_space = 2 + ; _ + } -> 0 + | _ -> 1 +;; + +let _ = + match something with + | [ very_very_long_field_name_running_out_of_space + ; another_very_very_long_field_name_running_out_of_space + ; _ + ] -> 0 + | _ -> 1 +;; + +let _ = + match something with + | [| very_very_long_field_name_running_out_of_space + ; another_very_very_long_field_name_running_out_of_space + ; _ + |] -> 0 + | _ -> 1 +;; + +[@@@ocamlformat "type-decl=compact"] + +type t = { aaaaaaaaa : aaaa; bbbbbbbbb : bbbb } +type trace_mod_funs = { trace_mod : bool option; trace_funs : bool Map.M(String).t } + +[@@@ocamlformat "type-decl=sparse"] + +module X = struct + val select + : (* The fsevents context *) + env + -> (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list + -> (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list + -> (* Timeout...like Unix.select *) + timeout:float + -> (* The callback for file system events *) + (event list -> unit) + -> unit +end + +type t = + { aaaaaaaaa : aaaa + ; bbbbbbbbb : bbbb + } + +type trace_mod_funs = + { trace_mod : bool option + ; trace_funs : bool Map.M(String).t + } + +let x { aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa } = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb = bbb bb bbbbbb } +;; + +let x + { aaaaaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaa + ; aaaaaaaaaa + } + = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbb = bbb bb bbbbbb + ; cccccc = cccc ccccccccccccccccccccccc + } +;; + +(* this is an array *) +let length = + [| 0 + ; 269999999999999999999999999999999999999999999999999 + ; 26 + ; (* foo *) 27 (* foo *) + ; 27 + ; 27 + |] + [@foo] +;; + +(* this is a list *) +let length = + [ 0; 14; (* foo *) 14; 17 (* foo *); 17; 2777777777777777777777777777777777; 27 ] [@foo] +;; + +Fooooooo.foo + ~foooooooooooooo + ~fooooooooo:"" + (Foo.foo + ~foo + ~foo + ~foooo:() + [ "fooooo", Foo.fooo ~foooo ~foooo:(foooo >*> fooooo) + ; "foooo", fooooooo + ; "foooooo", foooooooo + ; "fooooooooo", foooooooo + ]) + +class + ['aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb] x = + ['xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 'yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy] k + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb) e + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ('aaaaaaaaa, 'bbbbbbbbbbbb) e + +let ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + , yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy + , zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + , (aaaaaaaaaaaa, bbbbbbbbbbbb) ) + = + ( ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + , yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy + , zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz ) + , (aaaaaaaaaaaaaa, bbbbbbbbbbbb) ) +;; + +type t = aaaaaaaaaaaa -> bbbbbbbbbbbb -> cccccccccc + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + -> ccccccccccccccccccccccccc + +type t = + (* foooooooooooo *) + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + -> (* foooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + -> (* fooooooooooooooooo *) + ccccccccccccccccccccccccc + -> (* foooooo *) + foo * [ `Foo of foo * foo ] + -> (* foooooooooooooooo *) + foo + * foo + * foo + * foo + * [ `Foo of + (* fooooooooooooooooooo *) + foo * foo * foo + -> foo + -> foo + -> (* foooooooooooo *) + foo + -> foo + -> foo * foo + -> foo * foo + -> foo * foo + ] + -> (* foooooooooooooooo *) + fooooooooooooooooo + +type t = + { (* fooooooooooooooooo *) + foo : foo + ; (* foooooooooooooooooooooo fooooooooooooooooooo fooooooooooooooo + foooooooooooooooooo foooooooooooooooo *) + foo : + (* fooooooooooooooooooo *) + foooooooooooo + -> (* foooooooooooooo *) + foooooooooooooooo + -> foooooooooooooo + -> foooooooooo + -> fooooooooooooooo + ; foo : foo + } + +[@@@ocamlformat "ocp-indent-compat"] + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + -> ccccccccccccccccccccccccc + +type t = + (string Location.loc * payload) list + -> (string Location.loc * bool) list option * (string Location.loc * payload) list + -> (string Location.loc * bool) list option * (string Location.loc * payload) list + -> (string Location.loc * bool) list option * (string Location.loc * payload) list + +let x { aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa } = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb = bbb bb bbbbbb } +;; + +let x + { aaaaaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaa + ; aaaaaaaaaa + } + = + { aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbb = bbb bb bbbbbb + ; cccccc = cccc ccccccccccccccccccccccc + } +;; + +let foooooooooooooooooooooooooooooooooo = + { (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaa = aaaaaaaaaaaaaaaaa + ; (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + bbbbbbbbbbbbb = bbb bb bbbbbb + ; cccccc = cccc ccccccccccccccccccccccc + } +;; + +let foooooooooooo = + { foooooooooooooo with + fooooooooooooooooooooooooooooo = fooooooooooooo + ; fooooooooooooo = foooooooooooooo + } +;; + +let foooooooooooo = + { foooooooooooooo with + (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo + *) + fooooooooooooooooooooooooooooo = fooooooooooooo + ; fooooooooooooo = foooooooooooooo + } +;; + +let fooooooooooo = function + | Pmty_alias lid -> + { empty with + bdy = fmt_longident_loc c lid + ; epi = Some (fmt_attributes c ~key:"@" pmty_attributes ~pre:(fmt "@ ")) + } +;; + +let f () = + let { aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + } + = + some_value + in + foooooooooooo +;; + +let f () = + let [ aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + ] + = + some_value + in + foooooooooooo +;; + +let f () = + let [| aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + |] + = + some_value + in + foooooooooooo +;; + +let g () = + match some_value with + | { aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + } -> foooooooo + | [ aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + ] -> fooooooooo + | [| aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh + |] -> fooooooooo +;; + +let () = + match x with + | ( _ + , (* line 1 line 2 *) + Some _ ) -> x +;; + +let () = + match x with + | ( _ + , (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1 + veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 + *) + Some _ ) -> x +;; diff --git a/test/passing/refs.janestreet/break_sequence_before.ml.ref b/test/passing/refs.janestreet/break_sequence_before.ml.ref new file mode 100644 index 0000000000..8d00061230 --- /dev/null +++ b/test/passing/refs.janestreet/break_sequence_before.ml.ref @@ -0,0 +1,50 @@ +[@@@ocamlformat "sequence-style=before"] + +let foo x y = + lazy + (fooooooooooooooooooooooo + ; fooooooooooooooooooooooo + ;%ext + foooooooooooooooooooooooooo + ; fooooooooooooooooooooooooo) +;; + +let _ = + do_ + ;%ext + job_1 + ; job_2 + ; job_1 + ; job_2 + ; job_1 + ;%ext + job_2 + ; job_1 + ; job_2 + ; job_1 + ; job_2 + ; return () +;; + +let _ = + do_ + ; job_1 + ; job_2 + ;%ext + f + (job_1 + ; job_2 + ; job_1 + ; job_2 + ; job_1 + ;%ext + job_2 + ;%ext + job_2 + ; job_1 + ; job_2 + ; job_1 + ; job_2) + ;%ext + return () +;; diff --git a/test/passing/refs.janestreet/break_string_literals-never.ml.err b/test/passing/refs.janestreet/break_string_literals-never.ml.err new file mode 100644 index 0000000000..7e8a0e18ea --- /dev/null +++ b/test/passing/refs.janestreet/break_string_literals-never.ml.err @@ -0,0 +1,6 @@ +Warning: break_string_literals-never.ml:4 exceeds the margin +Warning: break_string_literals-never.ml:8 exceeds the margin +Warning: break_string_literals-never.ml:35 exceeds the margin +Warning: break_string_literals-never.ml:39 exceeds the margin +Warning: break_string_literals-never.ml:49 exceeds the margin +Warning: break_string_literals-never.ml:57 exceeds the margin diff --git a/test/passing/refs.janestreet/break_string_literals-never.ml.ref b/test/passing/refs.janestreet/break_string_literals-never.ml.ref new file mode 100644 index 0000000000..38e7130eb1 --- /dev/null +++ b/test/passing/refs.janestreet/break_string_literals-never.ml.ref @@ -0,0 +1,62 @@ +let () = + if true + then (* Shrinking the margin a bit *) + Format.printf + "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\ These are @{<warning>NOT@} the Droids you are looking for!@,@,\ Some more text. Just more letters and words.@,\ All this text is left-aligned because it's part of the UI.@,\ It'll be easier for the user to read this message.@]@\n@." +;; + +let fooooooo = + "@\n\n\ [Perf Profiler Log] Function: '%s' @\n\ count trace id = %i @\n\ sum inclusive cpu time = %f@\n\ avg inclusive time = %f @\n\ sum exclusive cpu time = %f @\n\ avg exclusive_time = %f @\n\ inclusive p90 = %f @\n\ exclusive p90 = %f @\n\ inclusive p50 = %f @\n\ exclusive p50 = %f @\n\ inclusive p25 = %f @\n\ exclusive p25 = %f @\n" +;; + +let foooo = + Printf.sprintf + "%s\nUsage: infer %s [options]\nSee `infer%s --help` for more information." +;; + +let pp_sep fmt () = F.fprintf fmt ", @,\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n\n\n" +let pp_sep fmt () = F.fprintf fmt ", @,@\n" +let pp_sep fmt () = F.fprintf fmt ", @,@\n@\n" +let pp_sep fmt () = F.fprintf fmt ", @,@\n@\n@\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n\n@\n\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n@;@\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n\n@,@\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n\n@\n\n" +let fooooooooo = Fooooo "[%a]\n" +let fooooooooo = Fooooo "[%a]@\n" +let fooooooooo = Fooooo "[%a]\n@\n" +let fooooooooo = Fooooo "[%a]@\n\n" +let fooo = Fooo "@\nFooooo: `%s`\n" + +let fooooooooooo = + "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum." +;; + +let fooooooooooo = + "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.@;Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat.@;Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur.@;Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum." +;; + +let _ = "abc@,def\n\nghi" +let _ = "abc@,def\n\n ghi" +let _ = "abc@,def\n\n" +let _ = "abc@,def@\n\n" + +let _ = + Pp.textf + "Failed to parse environment variable: %s=%s\nPermitted values: if-exists always never\nDefault: %s" + var + v + (to_string default) +;; + +let _ = + Pp.textf + "Failed to parse environment variable: %s=%s Permitted values: if-exists always never Default: %s" + var + v + (to_string default) +;; diff --git a/test/passing/refs.janestreet/break_string_literals.ml.ref b/test/passing/refs.janestreet/break_string_literals.ml.ref new file mode 100644 index 0000000000..2bb8bf3a59 --- /dev/null +++ b/test/passing/refs.janestreet/break_string_literals.ml.ref @@ -0,0 +1,96 @@ +let () = + if true + then (* Shrinking the margin a bit *) + Format.printf + "@[<v 2>@{<warning>@{<title>Warning@}@}@,\ + @,\ + \ These are @{<warning>NOT@} the Droids you are looking for!@,\ + @,\ + \ Some more text. Just more letters and words.@,\ + \ All this text is left-aligned because it's part of the UI.@,\ + \ It'll be easier for the user to read this message.@]@\n\ + @." +;; + +let fooooooo = + "@\n\n\ + \ [Perf Profiler Log] Function: '%s' @\n\ + \ count trace id = %i @\n\ + \ sum inclusive cpu time = %f@\n\ + \ avg inclusive time = %f @\n\ + \ sum exclusive cpu time = %f @\n\ + \ avg exclusive_time = %f @\n\ + \ inclusive p90 = %f @\n\ + \ exclusive p90 = %f @\n\ + \ inclusive p50 = %f @\n\ + \ exclusive p50 = %f @\n\ + \ inclusive p25 = %f @\n\ + \ exclusive p25 = %f @\n" +;; + +let foooo = + Printf.sprintf + "%s\nUsage: infer %s [options]\nSee `infer%s --help` for more information." +;; + +let pp_sep fmt () = F.fprintf fmt ", @,\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n\n\n" +let pp_sep fmt () = F.fprintf fmt ", @,@\n" +let pp_sep fmt () = F.fprintf fmt ", @,@\n@\n" +let pp_sep fmt () = F.fprintf fmt ", @,@\n@\n@\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n\n@\n\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n@;@\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n\n@,@\n" +let pp_sep fmt () = F.fprintf fmt ", @,\n@\n\n@\n\n" +let fooooooooo = Fooooo "[%a]\n" +let fooooooooo = Fooooo "[%a]@\n" +let fooooooooo = Fooooo "[%a]\n@\n" +let fooooooooo = Fooooo "[%a]@\n\n" +let fooo = Fooo "@\nFooooo: `%s`\n" + +let fooooooooooo = + "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor \ + incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud \ + exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure \ + dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla \ + pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia \ + deserunt mollit anim id est laborum." +;; + +let fooooooooooo = + "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor \ + incididunt ut labore et dolore magna aliqua.@;\ + Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex \ + ea commodo consequat.@;\ + Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu \ + fugiat nulla pariatur.@;\ + Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt \ + mollit anim id est laborum." +;; + +let _ = "abc@,def\n\nghi" +let _ = "abc@,def\n\n ghi" +let _ = "abc@,def\n\n" +let _ = "abc@,def@\n\n" + +let _ = + Pp.textf + "Failed to parse environment variable: %s=%s\n\ + Permitted values: if-exists always never\n\ + Default: %s" + var + v + (to_string default) +;; + +let _ = + Pp.textf + "Failed to parse environment variable: %s=%s Permitted values: if-exists always \ + never Default: %s" + var + v + (to_string default) +;; diff --git a/test/passing/refs.janestreet/break_struct.ml.ref b/test/passing/refs.janestreet/break_struct.ml.ref new file mode 100644 index 0000000000..d4e387a42d --- /dev/null +++ b/test/passing/refs.janestreet/break_struct.ml.ref @@ -0,0 +1,86 @@ +[@@@ocamlformat "break-struct=natural"] + +module M = X (Y) (struct let x = k end) + +module Hash = struct + include Hash + + module type S = S.HASH +end + +module Hash = struct + include Hash + include Hash + + module type S = S.HASH + module type S = S.HASH +end + +module Hash = struct + include Hash + include Hash + include Hash + + module type S = S.HASH + module type S = S.HASH + module type S = S.HASH +end + +module Hash = struct + let z = + zzzzzzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzz + zzzzzzzzzz + ;; + + let z = + zzzzzzzzzzzzzz + zzzzzzzzzzzzzzz + zzzzzzzzzzzzzzz + zzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzz + ;; + + include Hash + + module type S = S.HASH +end + +module Vector = struct + include Vector + + let pp sep pp_elt fs v = List.pp sep pp_elt fs (to_list v) +end + +module Hash = struct + include Hash + include Hash + + module type S = S.HASH + module type S = S.HASH +end + +module M = struct include A end +module M = struct include A include B end +module M = struct include A include B include C end +module M = struct include A include B include C include D end + +module M = struct + include A + include B + include C + include D + + let x = xxxxxxxxxxx xxxxxxxxxxxxx + let z = zzzzzzzzzzzzz +end + +include ( + Ast_407 : + module type of struct include Ast_407 end with module Location := Ast_407.Location) diff --git a/test/passing/refs.janestreet/cases_exp_grouping.ml.ref b/test/passing/refs.janestreet/cases_exp_grouping.ml.ref new file mode 100644 index 0000000000..fe13c9ecbc --- /dev/null +++ b/test/passing/refs.janestreet/cases_exp_grouping.ml.ref @@ -0,0 +1,98 @@ +let _ = + match x with + | A -> begin match B with A -> fooooooooooooo end + | A -> begin match B with A -> fooooooooooooo | B -> fooooooooooooo end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + | C -> fooooooooooooo + | D -> fooooooooooooo + end +[@@ocamlformat "break-cases=fit"] +;; + +let _ = + match x with + | A -> begin + match B with A -> fooooooooooooo + end + | A -> begin + match B with A -> fooooooooooooo | B -> fooooooooooooo + end + | A -> begin + match B with + | A -> + fooooooooooooo + | B -> + fooooooooooooo + | C -> + fooooooooooooo + | D -> + fooooooooooooo + end +[@@ocamlformat "break-cases=nested"] +;; + +let _ = + match x with + | A -> begin + match B with + | A -> fooooooooooooo + end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + | C -> fooooooooooooo + | D -> fooooooooooooo + end +[@@ocamlformat "break-cases=toplevel"] +;; + +let _ = + match x with + | A -> begin + match B with + | A -> fooooooooooooo + end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + | C -> fooooooooooooo + | D -> fooooooooooooo + end +[@@ocamlformat "break-cases=fit-or-vertical"] +;; + +let _ = + match x with + | A -> begin + match B with + | A -> fooooooooooooo + end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + | C -> fooooooooooooo + | D -> fooooooooooooo + end +[@@ocamlformat "break-cases=all"] +;; diff --git a/test/passing/refs.janestreet/cinaps.ml.ref b/test/passing/refs.janestreet/cinaps.ml.ref new file mode 100644 index 0000000000..2ef03a0595 --- /dev/null +++ b/test/passing/refs.janestreet/cinaps.ml.ref @@ -0,0 +1,76 @@ +(*$ + for i = 1 to 3 do + Printf.printf "let x%d = %d\n" i i + done +$*) +let x1 = 1 + +(*$*) + +let x = 1 + +(*$ + print_newline (); + List.iter + (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s) + [ "+"; "-"; "*"; "/" ] +*) + +(*$*) +let y = 2 + +(*$ + #use "import.cinaps";; + + List.iter all_fields ~f:(fun (name, type_) -> + printf "\nexternal get_%s\n : unit -> %s = \"get_%s\"" name type_ name) +*) +external get_name : unit -> string = "get_name" + +(*$*) + +let x = 1 + +(*$ + let x = 1 in + (* fooooooo *) + let y = 2 in + (* foooooooo *) + z +$*) + +(*$*) + +let foo = foo + +(*$QR foo Q.small_int (fun i-> foo i (+) [1;2;3] = List.fold_left (+) i + [1;2;3] ) *) +let foo = foo + +(* Cinaps comment should not wrap if they don't parse. The first one would + crash and the second become a mess *) + +(*$(**)" + "*) + +(*$ + print_newline () ; + <SYNTAX ERROR> + List.iter + (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s) + ["+"; "-"; "*"; "/"] +*) + +(*$*) + +(*$ + (* + x + *) +*) + +(*$*) + +(*$ let _ = [ x (* *); y ] *) + +(*$*) diff --git a/test/passing/refs.janestreet/class_expr.ml.ref b/test/passing/refs.janestreet/class_expr.ml.ref new file mode 100644 index 0000000000..8e728e4f6b --- /dev/null +++ b/test/passing/refs.janestreet/class_expr.ml.ref @@ -0,0 +1,18 @@ +class c (`I i) = x +class c `I = x +class c i = x +class c (* xx *) i (* yy *) = x + +class c = + object + method class_infos : 'a. ('a -> 'res) -> 'a class_infos -> 'res = + fun _a { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } -> + let pci_virt = self#virtual_flag pci_virt in + let pci_params = self#list in + () + end + +class c = + (let () = print_endline "Class init" in + with_param) + () diff --git a/test/passing/refs.janestreet/class_sig-after.mli.ref b/test/passing/refs.janestreet/class_sig-after.mli.ref new file mode 100644 index 0000000000..7ed2e66b19 --- /dev/null +++ b/test/passing/refs.janestreet/class_sig-after.mli.ref @@ -0,0 +1,37 @@ +class c : 'a -> object + val x : 'b +end + +(** Fitting *) + +class c : object end +class c : int -> object end +class c : int -> object end[@attr] +class c : int -> object end [@@attr] +class c : int -> object end +class c (* a *) : (* b *) int (* c *) -> (* d *) object (* e *) end (* f *) +class c : object end + +class c : object + (** Standalone doc-string. *) +end + +class unix_mockup : + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> + bar + +class unix_mockup : + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> + foooo:string -> +object + method foo : string +end diff --git a/test/passing/refs.janestreet/class_sig.mli.ref b/test/passing/refs.janestreet/class_sig.mli.ref new file mode 100644 index 0000000000..fba225bc2b --- /dev/null +++ b/test/passing/refs.janestreet/class_sig.mli.ref @@ -0,0 +1,38 @@ +class c : 'a -> object + val x : 'b +end + +(** Fitting *) + +class c : object end +class c : int -> object end +class c : int -> object end[@attr] +class c : int -> object end [@@attr] +class c : int -> object end +class c (* a *) : (* b *) int (* c *) -> (* d *) object (* e *) end (* f *) +class c : object end + +class c : object + (** Standalone doc-string. *) +end + +class unix_mockup : + foooo:string + -> foooo:string + -> foooo:string + -> foooo:string + -> foooo:string + -> foooo:string + -> bar + +class unix_mockup : + foooo:string + -> foooo:string + -> foooo:string + -> foooo:string + -> foooo:string + -> foooo:string + -> +object + method foo : string +end diff --git a/test/passing/refs.janestreet/class_type.ml.ref b/test/passing/refs.janestreet/class_type.ml.ref new file mode 100644 index 0000000000..2287282423 --- /dev/null +++ b/test/passing/refs.janestreet/class_type.ml.ref @@ -0,0 +1,15 @@ +class c : x -> y -> z = object end + +class c : + (* fooooooooooooo foooooooooo *) xxxxxxxxxxxxxx + -> (* fooooooooo foooooooooo *) yyyyyyyyyyyyyy + -> (* fooooooooooooo fooooooooooo *) zzzzzzzzzzzzzzzzzz = object end + +class c : + (* fooooooooooooo foooooooooo *) xxxxxxxxxxxxxx (* fooooooooooo *) + -> (* fooooooooo foooooooooo *) yyyyyyyyyyyyyy (* foooooooooooooo *) + -> (* fooooooooooooo fooooooooooo *) zzzzzzzzzzzzzzzzzz (* fooooooooooooooooo *) = + object end + +class c : (a -> b) -> x = object end +class c : x -> (a -> b) -> y = object end diff --git a/test/passing/refs.janestreet/cmdline_override.ml.ref b/test/passing/refs.janestreet/cmdline_override.ml.ref new file mode 100644 index 0000000000..b098640eef --- /dev/null +++ b/test/passing/refs.janestreet/cmdline_override.ml.ref @@ -0,0 +1,3 @@ +let x = 1 + +let y = 2 diff --git a/test/passing/refs.janestreet/cmdline_override2.ml.ref b/test/passing/refs.janestreet/cmdline_override2.ml.ref new file mode 100644 index 0000000000..b098640eef --- /dev/null +++ b/test/passing/refs.janestreet/cmdline_override2.ml.ref @@ -0,0 +1,3 @@ +let x = 1 + +let y = 2 diff --git a/test/passing/refs.janestreet/coerce.ml.ref b/test/passing/refs.janestreet/coerce.ml.ref new file mode 100644 index 0000000000..88abfda5ba --- /dev/null +++ b/test/passing/refs.janestreet/coerce.ml.ref @@ -0,0 +1,30 @@ +let _ = + let a :> x = v in + let a : x :> y = v in + let a = (v :> x) in + let a = (v : x :> y) in + let a : x :> y = (v : x :> y) in + () +;; + +let a :> x = v +let a : x :> y = v +let a = (v :> x) +let a = (v : x :> y) +let a : x :> y = (v : x :> y) + +class c = + let a :> x = v in + let a : x :> y = v in + let a = (v :> x) in + let a = (v : x :> y) in + let a : x :> y = (v : x :> y) in + object end + +let f (type a) :> a M.u = function + | z -> z +;; + +let f x (type a) :> a M.u = function + | z -> z +;; diff --git a/test/passing/refs.janestreet/comment_breaking.ml.ref b/test/passing/refs.janestreet/comment_breaking.ml.ref new file mode 100644 index 0000000000..62167eb5ff --- /dev/null +++ b/test/passing/refs.janestreet/comment_breaking.ml.ref @@ -0,0 +1,10 @@ +let () = + foo aaaaaaaaaa bbbbbbbbbb cccccccccc |> (ignore : t -> _); + bar dddddddddd eeeeeeeeee ffffffffff |> (ignore : t -> _) +;; + +let () = + (* this comment should not change breaking of the following line *) + foo aaaaaaaaaa bbbbbbbbbb cccccccccc |> (ignore : t -> _); + bar dddddddddd eeeeeeeeee ffffffffff |> (ignore : t -> _) +;; diff --git a/test/passing/refs.janestreet/comment_header.ml.ref b/test/passing/refs.janestreet/comment_header.ml.ref new file mode 100644 index 0000000000..aabb853bdc --- /dev/null +++ b/test/passing/refs.janestreet/comment_header.ml.ref @@ -0,0 +1,60 @@ +(**************************************************************************) +(* *) +(* XXXXX *) +(* *) +(* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXxx *) +(* *) +(* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *) +(* XXXXXXXXXXXxXX. *) +(* *) +(* XXXXXXXXXXXXXXXXXXX. XXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXX *) +(* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXxX *) +(* XXXXXXX XXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXX XXXXXXXXXXXXXXXXX *) +(* *) +(**************************************************************************) + +(* XXXXXXX xxxxxxxxxxxxx XXXXXXXXXXXXXXXXXXXXx xxxxxxxxx xxxxxxxxx x xxxxxx + xxxxxx. *) + +open Module + +type typ = typ + +(* XXXXXXXXXXXXXX XX XXxxxxxxxx *) + +(* b *) +(*******) +(* *) +(* *) +(* *) +(* *) +(*******) +(* b *) + +(*******) +(* *) +(* *) +(* *) +(* *) +(*****) + +(* xxxxxxxxxxxxxxxxx, xxxxxxx xxxxxx (xxxxxxxxxxxxxx) xxxxxxxxx xxxxxxx + xxxxxxxxxxxxxx xxxxxxxxxxxxx. *) +(* xx xxxxxxxxxxxxxx, x xxxxxxxxxxxxxx "xxxxxxxxx" xxxxxxxxxxxxxxxxxxxx + xxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxx xxxxx. *) + +(* TEST + arguments = "???" +*) + +(* On Windows the runtime expand windows wildcards (asterisks and + * question marks). + * + * This file is a non-regression test for github's PR#1623. + * + * On Windows 64bits, a segfault was triggered when one argument consists + * only of wildcards. + * + * The source code of this test is empty: we just check the arguments + * expansion. + * *) diff --git a/test/passing/refs.janestreet/comment_in_empty.ml.ref b/test/passing/refs.janestreet/comment_in_empty.ml.ref new file mode 100644 index 0000000000..6650b140b0 --- /dev/null +++ b/test/passing/refs.janestreet/comment_in_empty.ml.ref @@ -0,0 +1,46 @@ +module M = struct + (* this module is empty *) +end + +module type M = sig + (* this module type is empty *) +end + +class type m = object end (* this class type is empty *) + +let x = object (* this object is empty *) end +let _ = [ (* this list is empty *) ] +let _ = (* this list is empty2 *) [] +let _ = (* this list is empty2 *) [] +let _ = [| (* this array is empty *) |] +let _ = f ( (* comment in unit *) ) +let _ = f "asd" (* te""st *) 3 + +let x = function + | [ (* empty list pat *) ] + | [| (* empty array pat *) |] + | ( (* unit pat *) ) + | "" (* comment *) -> () +;; + +let x = + object + method x () = {< (* this override is empty *) >} + end +;; + +type t = private [> (*this variant is empty *) ] +type t = < (* this object type is empty *) > +type t = < .. (* this object type is empty *) > + +let x = + ( (* Lorem ipsum dolor sit amet, consectetur adipiscing elit. Sed non + risus. Suspendisse lectus tortor, dignissim sit amet, adipiscing nec, + ultricies sed, dolor. *) ) +;; + +let x = + [ (* Lorem ipsum dolor sit amet, consectetur adipiscing elit. Sed non + risus. Suspendisse lectus tortor, dignissim sit amet, adipiscing nec, + ultricies sed, dolor. *) ] +;; diff --git a/test/passing/refs.janestreet/comment_in_modules.ml.ref b/test/passing/refs.janestreet/comment_in_modules.ml.ref new file mode 100644 index 0000000000..925033ce79 --- /dev/null +++ b/test/passing/refs.janestreet/comment_in_modules.ml.ref @@ -0,0 +1,31 @@ +module M = struct + (* comments *) +end + +module M : sig + (* comments *) +end = struct + (* comments *) +end + +module type M = sig + (* comments *) +end + +(** Xxxxxxx xxxxxxxx xx xxxxxxx xxxxxxxxxxxxx xxxxxxxxx xx xxxx *) +module Mmmmmmmmmmmmmmmmmmmmmm = Aaaaaaaaaaaaaaaaaaaaaa.Bbbbbbbbbbbbbbbbbbbbbbbb + +(** Xxxxxxx xxxxxxxx xx xxxxxxx xxxxxxxxxxxxx xxxxxxxxx xx xxxx *) +module Fffffffffffffff (Yyyyyyyyyyyyyyy : Z.S) = Gggggggggg (Wwwwwwwwww.Make (Yyyyyyyyyy)) + +module A (* comment *) (A : sig end) : sig end = struct end +module A (A : sig end) (* comment *) (B : sig end) : sig end = struct end +module A (A : sig end) : sig end = (* comment *) struct end +module (* comment *) A (A : sig end) : sig end = struct end + +module rec A : A = struct end + +(** floatting *) + +(** about b *) +and B : B = struct end diff --git a/test/passing/refs.janestreet/comment_last.ml.ref b/test/passing/refs.janestreet/comment_last.ml.ref new file mode 100644 index 0000000000..2006814fe3 --- /dev/null +++ b/test/passing/refs.janestreet/comment_last.ml.ref @@ -0,0 +1,4 @@ +let x = 2 +let y = 3 + +(*comment*) diff --git a/test/passing/refs.janestreet/comment_sparse.ml.ref b/test/passing/refs.janestreet/comment_sparse.ml.ref new file mode 100644 index 0000000000..7651560da3 --- /dev/null +++ b/test/passing/refs.janestreet/comment_sparse.ml.ref @@ -0,0 +1,11 @@ +[@@@ocamlformat "break-cases=nested"] + +let f x = + match x with + | `A -> + () + | `B -> + (* Proin ipsum nunc, finibus et finibus, semper et mi. Aenean *) + (* pretium fermentum tellus, a faucibus sagittis et. Cras non *) + () +;; diff --git a/test/passing/refs.janestreet/comments-no-wrap.ml.err b/test/passing/refs.janestreet/comments-no-wrap.ml.err new file mode 100644 index 0000000000..0b03d7c3ab --- /dev/null +++ b/test/passing/refs.janestreet/comments-no-wrap.ml.err @@ -0,0 +1,3 @@ +Warning: comments-no-wrap.ml:207 exceeds the margin +Warning: comments-no-wrap.ml:267 exceeds the margin +Warning: comments-no-wrap.ml:433 exceeds the margin diff --git a/test/passing/refs.janestreet/comments-no-wrap.ml.ref b/test/passing/refs.janestreet/comments-no-wrap.ml.ref new file mode 100644 index 0000000000..3af9fd125a --- /dev/null +++ b/test/passing/refs.janestreet/comments-no-wrap.ml.ref @@ -0,0 +1,496 @@ +(* *) + +(**) + +(* *) + +(*$*) +(*$ *) +(*$ *) + +let _ = f (*f*) a (*a*) ~b (*comment*) ~c:(*comment*) c' ?d ?e () + +let _ = + let _ = + f + (*comment*) + (let open M in + let x = x in + e) + in + () +;; + +let _ = (*comment*) a (*comment*), b + +let foo = function + | Blah ((* old *) x, y) -> () +;; + +let foo = function + | Blah (x (* old *), y) -> () +;; + +let foo = function + | Blah, (* old *) (x, y) -> () +;; + +let foo = function + | Blah (x, y) (* old *) -> () +;; + +let foo = function + | Blah, (x, y (* old *)) -> () +;; + +let foo = function + | Blah, (x, (* old *) y) -> () +;; + +let foo = function + | (x, y) (* old *), z -> () +;; + +let _ = if (* a0 *) b(* c0 *) then (* d0 *) e (* f0 *) else (* g0 *) h (* i0 *) +let _ = if (* a1 *) b(* c1 *) then (* d1 *) e (* f1 *) else (* g1 *) h (* i1 *) +let _ = if (* a2 *) B(* c2 *) then (* d2 *) E (* f2 *) else (* g2 *) H (* i2 *) +let _ = if (* a3 *) B(* c3 *) then (* d3 *) E (* f3 *) else (* g3 *) H (* i3 *);; + +match x with +| true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" +| false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +(* this comment should not change the formatting of the following case *) +| false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +;; + +try f x with +(* this comment is intended to refer to the entire case below *) +| Caml.Not_found -> () +;; + +match x with +(* this comment is intended to refer to the entire case below *) +| false -> () +;; + +match x with +| Aaaaaaaaaaaaaaaaaaaa +(* this comment is intended to refer to the case below *) +| Bbbbbbbbbbbbbbbbbbbb -> () + +let _ = + (* this comment is intended to refer to the entire match below *) + match x with + | "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" -> () + | "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" -> () +;; + +module type M = sig + val f (* A list of [name], [count] pairs. *) : (string * int) list -> int +end + +let _ = f ~f:(fun a b -> c) (* comment *) ~f:(fun a b -> c) +let _ = f (fun x -> g h) (* comment *) ~f:(fun a b -> c) +let _ = f (g h) (* comment *) ~f:(fun a b -> c) +let _ = f (0 + 0 (* test *) + (1 * 1) (* test *)) +let _ = f ((1 * 1) (* test *) + (0 + 0) (* test *)) + +let _ = + match e with + | 3 (* test *) -> e + | 3 (* test *) :: tail -> e +;; + +let _ = if a then b :: c (* d *) else e +let (b :: c (* d *)) = x + +module rec A = struct end + +(*test*) +and B = struct end + +module type T = sig + module rec A : sig end + + (*test*) + and B : sig end +end + +let f = (* comment *) function + | x -> x +;; + +let foo x = (* comment *) (y : z) + +let _ = + (*a*) + s (*b*).((*c*) + (*d*) + i + (*e*)) +;; + +let _ = + (*a*) + s (*b*).((*c*) + (*d*) + i + (*e*)) + <- (*f*) + (*g*) + x +;; + +let _ = + (*a*) + s (*b*).[(*c*) + (*d*) + i + (*e*)] +;; + +let _ = + (*a*) + s (*b*).[(*c*) + (*d*) + i + (*e*)] + <- (*f*) + (*g*) + x +;; + +let _ = + (*a*) + s (*b*).{(*c*) + (*d*) + i + (*e*)} +;; + +let _ = + (*a*) + s (*b*).{(*c*) + (*d*) + i + (*e*)} + <- (*f*) + (*g*) + x +;; + +let _ = (*a*) s (*b*).%{(*c*) i (*d*)} + +let _ = + (*a*) + s (*b*).%{(*c*) i (*d*)} + <- (*e*) + (*f*) + x +;; + +type t = + { a : int [@default a] (* comment *) + ; b : flag + } + +let () = + (* *) + + (* *) + () +;; + +(* break when unicode sequence length measured in bytes but ¬ in code points *) + +type t = + | Aaaaaaaaaa + (* Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. *) + | Bbbbbbbbbb (* foo *) + | Bbbbbbbbbb (* foo *) + +let () = + xxxxxxxxxx + || + (* xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +;; + +let () = + xxxxxxxxxx + land + (* xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +;; + +let rec fooooooooooo = function + (*XX*) + | x :: t (*YY*) -> k + (* AA*) + | [ (*BB*) + (* CC *) + x + (* DD *) + ; (* EE *) + y + (* FF *) + (* GG *) + ] + (* HH *) -> k + (* AA*) + (*BB*) + (* CC *) + | x (* DD *) :: (* EE *) t + (* FF *) + (* GG *) + (* HH *) -> k + (* AA*) + (*BB*) + (* CC *) + | x + (* DD *) + (* XX *) + :: (* YY *) + (* EE *) t + (* FF *) + (* GG *) + (* HH *) -> k + (* AA *) + (* BB *) + | (module (* CC *) + (* DD *) F (* EE *) : (* FF *) M (* GG *)) (* HH *) + :: (* II *) t + (* JJ *) + (* KK *) -> foo +;; + +let%map + (* __________________________________________________________________________________________ *) + _ + = + () +;; + +type t = + < (* a *) + a : int [@atr] (* b *) + ; b : int + (* c *) > + +type t = < a : int (* a *) ; (* b *) .. (* c *) > +type t = < (* a *) .. (* b *) > + +class type i = object + (* test *) + inherit oo +end + +class i = + object + (* test *) + inherit oo + end + +let _ = + try_with (fun () -> + (* comment before *) + match get () with + | None -> do_something () + | Some _ -> () (* do nothing *)) +;; + +let _ = + try_with (fun () -> + (* comment before *) + a; + b (* after b *)) +;; + +let _ = + match x with + | Some y -> + (match y with + | None -> () + | Some z -> incr z (* double some *)) + | None -> () +;; + +type prefix = { sib_extend : int (** add more as needed *) (* extended sib index bit *) } + +type t = + | A (* A *) + (* | B *) + | C + +type t = + (* | B *) + | A (* A *) + | C + +type t = + | A + (* A *) + (* | B *) + | C + +type foo = + | Alpha + | Beta +[@@ocaml.warning "-37" (* Explanation of warning *)] + +type foo = + | Alpha______________________________ + | Beta_______________________________ +[@@ocaml.warning "-37" (* Explanation of warning *)] + +let y = + f + (* a *) + (* b *) + x +;; + +module A (* A *) () (* B *) = (* C *) B + +let kk = (* foo *) (module A : T) +let kk = (* foo *) (module A : T) +let kk = (module A : T) (* foo *) +let kk = (* foo *) (module A : T) (* foo *) + +let kk = + (* before exp *) + (* before exp_pack *) + (module (* before A *) A (* after A *)) +;; + +(* after exp_pack *) + +(* after exp *) + +let kk = + (* before exp *) + (* before exp_pack *) + (module (* before A *) A (* after A *) : (* before S *) S (* after S *)) +;; + +(* after exp_pack *) + +(* after exp *) + +let _ = assert (foo (bar + baz <= quux)) +(* this comment should stay attached to the preceding item *) + +let _ = foo + +let a = + [ b + (* *) + (* c *) + ] +;; + +let _ = + (1 + + + (* foooooooooooooooooooooooo fooooooooooooooo fooooooooooooooooo *) + fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + - + (* fooooooooooooo foooooooooooooooooooooo foooooooooooooooooooo *) + (foooooooooooooo foooooooooooooo foooooooooooooooooo fooooooooo + % + (* foooooooooooooooo foooooooooooo foooooooooooooooooo *) + fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + / + (* foooooooooooooooooooooooo fooooooooooooooo fooooooooooooooooo *) + barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr + * + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo) + $ + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + & + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + = + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + > + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + < + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + @ foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + ^ + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo) + || + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo + foooooooooooooooo + fooooooooooooooo#= + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo + foooooooooooooooo + fooooooooooooooo +;; + +let _ = + ! + (*a*) + (*b*) + x +;; + +let _ = + (*x*) + ! + (*a*) + (*b*) + x + (*c*) y +;; + +let _ = + f + ((*x*) + ! + (*a*) + (*b*) + x + (*c*) y) + y +;; + +type a = b (* a *) as (* b *) 'c (* c *) + +type t = + { (* comment before mutable *) + mutable + (* really long comment that doesn't fit on the same line as other stuff *) + x : + int + } + +let _ = (x + y) [@attr] + z +let _ = x ^ (y ^ z) [@attr] + +let _ = + (); + (* indentation preserved + *) + (); + (* indentation preserved + *) + (); + (* indentation preserved + *) + (); + (* indentation not preserved + *) + () +;; + +let vexpr (*aa*) (type (*bb*) a) (*cc*) (type (*dd*) b) (*ee*) : _ -> _ = k diff --git a/test/passing/refs.janestreet/comments.ml.err b/test/passing/refs.janestreet/comments.ml.err new file mode 100644 index 0000000000..e8d306adde --- /dev/null +++ b/test/passing/refs.janestreet/comments.ml.err @@ -0,0 +1,3 @@ +Warning: comments.ml:207 exceeds the margin +Warning: comments.ml:267 exceeds the margin +Warning: comments.ml:433 exceeds the margin diff --git a/test/passing/refs.janestreet/comments.ml.ref b/test/passing/refs.janestreet/comments.ml.ref new file mode 100644 index 0000000000..3af9fd125a --- /dev/null +++ b/test/passing/refs.janestreet/comments.ml.ref @@ -0,0 +1,496 @@ +(* *) + +(**) + +(* *) + +(*$*) +(*$ *) +(*$ *) + +let _ = f (*f*) a (*a*) ~b (*comment*) ~c:(*comment*) c' ?d ?e () + +let _ = + let _ = + f + (*comment*) + (let open M in + let x = x in + e) + in + () +;; + +let _ = (*comment*) a (*comment*), b + +let foo = function + | Blah ((* old *) x, y) -> () +;; + +let foo = function + | Blah (x (* old *), y) -> () +;; + +let foo = function + | Blah, (* old *) (x, y) -> () +;; + +let foo = function + | Blah (x, y) (* old *) -> () +;; + +let foo = function + | Blah, (x, y (* old *)) -> () +;; + +let foo = function + | Blah, (x, (* old *) y) -> () +;; + +let foo = function + | (x, y) (* old *), z -> () +;; + +let _ = if (* a0 *) b(* c0 *) then (* d0 *) e (* f0 *) else (* g0 *) h (* i0 *) +let _ = if (* a1 *) b(* c1 *) then (* d1 *) e (* f1 *) else (* g1 *) h (* i1 *) +let _ = if (* a2 *) B(* c2 *) then (* d2 *) E (* f2 *) else (* g2 *) H (* i2 *) +let _ = if (* a3 *) B(* c3 *) then (* d3 *) E (* f3 *) else (* g3 *) H (* i3 *);; + +match x with +| true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" +| false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +(* this comment should not change the formatting of the following case *) +| false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +;; + +try f x with +(* this comment is intended to refer to the entire case below *) +| Caml.Not_found -> () +;; + +match x with +(* this comment is intended to refer to the entire case below *) +| false -> () +;; + +match x with +| Aaaaaaaaaaaaaaaaaaaa +(* this comment is intended to refer to the case below *) +| Bbbbbbbbbbbbbbbbbbbb -> () + +let _ = + (* this comment is intended to refer to the entire match below *) + match x with + | "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" -> () + | "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" -> () +;; + +module type M = sig + val f (* A list of [name], [count] pairs. *) : (string * int) list -> int +end + +let _ = f ~f:(fun a b -> c) (* comment *) ~f:(fun a b -> c) +let _ = f (fun x -> g h) (* comment *) ~f:(fun a b -> c) +let _ = f (g h) (* comment *) ~f:(fun a b -> c) +let _ = f (0 + 0 (* test *) + (1 * 1) (* test *)) +let _ = f ((1 * 1) (* test *) + (0 + 0) (* test *)) + +let _ = + match e with + | 3 (* test *) -> e + | 3 (* test *) :: tail -> e +;; + +let _ = if a then b :: c (* d *) else e +let (b :: c (* d *)) = x + +module rec A = struct end + +(*test*) +and B = struct end + +module type T = sig + module rec A : sig end + + (*test*) + and B : sig end +end + +let f = (* comment *) function + | x -> x +;; + +let foo x = (* comment *) (y : z) + +let _ = + (*a*) + s (*b*).((*c*) + (*d*) + i + (*e*)) +;; + +let _ = + (*a*) + s (*b*).((*c*) + (*d*) + i + (*e*)) + <- (*f*) + (*g*) + x +;; + +let _ = + (*a*) + s (*b*).[(*c*) + (*d*) + i + (*e*)] +;; + +let _ = + (*a*) + s (*b*).[(*c*) + (*d*) + i + (*e*)] + <- (*f*) + (*g*) + x +;; + +let _ = + (*a*) + s (*b*).{(*c*) + (*d*) + i + (*e*)} +;; + +let _ = + (*a*) + s (*b*).{(*c*) + (*d*) + i + (*e*)} + <- (*f*) + (*g*) + x +;; + +let _ = (*a*) s (*b*).%{(*c*) i (*d*)} + +let _ = + (*a*) + s (*b*).%{(*c*) i (*d*)} + <- (*e*) + (*f*) + x +;; + +type t = + { a : int [@default a] (* comment *) + ; b : flag + } + +let () = + (* *) + + (* *) + () +;; + +(* break when unicode sequence length measured in bytes but ¬ in code points *) + +type t = + | Aaaaaaaaaa + (* Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. *) + | Bbbbbbbbbb (* foo *) + | Bbbbbbbbbb (* foo *) + +let () = + xxxxxxxxxx + || + (* xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +;; + +let () = + xxxxxxxxxx + land + (* xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +;; + +let rec fooooooooooo = function + (*XX*) + | x :: t (*YY*) -> k + (* AA*) + | [ (*BB*) + (* CC *) + x + (* DD *) + ; (* EE *) + y + (* FF *) + (* GG *) + ] + (* HH *) -> k + (* AA*) + (*BB*) + (* CC *) + | x (* DD *) :: (* EE *) t + (* FF *) + (* GG *) + (* HH *) -> k + (* AA*) + (*BB*) + (* CC *) + | x + (* DD *) + (* XX *) + :: (* YY *) + (* EE *) t + (* FF *) + (* GG *) + (* HH *) -> k + (* AA *) + (* BB *) + | (module (* CC *) + (* DD *) F (* EE *) : (* FF *) M (* GG *)) (* HH *) + :: (* II *) t + (* JJ *) + (* KK *) -> foo +;; + +let%map + (* __________________________________________________________________________________________ *) + _ + = + () +;; + +type t = + < (* a *) + a : int [@atr] (* b *) + ; b : int + (* c *) > + +type t = < a : int (* a *) ; (* b *) .. (* c *) > +type t = < (* a *) .. (* b *) > + +class type i = object + (* test *) + inherit oo +end + +class i = + object + (* test *) + inherit oo + end + +let _ = + try_with (fun () -> + (* comment before *) + match get () with + | None -> do_something () + | Some _ -> () (* do nothing *)) +;; + +let _ = + try_with (fun () -> + (* comment before *) + a; + b (* after b *)) +;; + +let _ = + match x with + | Some y -> + (match y with + | None -> () + | Some z -> incr z (* double some *)) + | None -> () +;; + +type prefix = { sib_extend : int (** add more as needed *) (* extended sib index bit *) } + +type t = + | A (* A *) + (* | B *) + | C + +type t = + (* | B *) + | A (* A *) + | C + +type t = + | A + (* A *) + (* | B *) + | C + +type foo = + | Alpha + | Beta +[@@ocaml.warning "-37" (* Explanation of warning *)] + +type foo = + | Alpha______________________________ + | Beta_______________________________ +[@@ocaml.warning "-37" (* Explanation of warning *)] + +let y = + f + (* a *) + (* b *) + x +;; + +module A (* A *) () (* B *) = (* C *) B + +let kk = (* foo *) (module A : T) +let kk = (* foo *) (module A : T) +let kk = (module A : T) (* foo *) +let kk = (* foo *) (module A : T) (* foo *) + +let kk = + (* before exp *) + (* before exp_pack *) + (module (* before A *) A (* after A *)) +;; + +(* after exp_pack *) + +(* after exp *) + +let kk = + (* before exp *) + (* before exp_pack *) + (module (* before A *) A (* after A *) : (* before S *) S (* after S *)) +;; + +(* after exp_pack *) + +(* after exp *) + +let _ = assert (foo (bar + baz <= quux)) +(* this comment should stay attached to the preceding item *) + +let _ = foo + +let a = + [ b + (* *) + (* c *) + ] +;; + +let _ = + (1 + + + (* foooooooooooooooooooooooo fooooooooooooooo fooooooooooooooooo *) + fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + - + (* fooooooooooooo foooooooooooooooooooooo foooooooooooooooooooo *) + (foooooooooooooo foooooooooooooo foooooooooooooooooo fooooooooo + % + (* foooooooooooooooo foooooooooooo foooooooooooooooooo *) + fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + / + (* foooooooooooooooooooooooo fooooooooooooooo fooooooooooooooooo *) + barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr + * + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo) + $ + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + & + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + = + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + > + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + < + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + @ foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo + ^ + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo) + || + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo + foooooooooooooooo + fooooooooooooooo#= + (* convert from foos to bars blah blah blah blah blah blah blah blah *) + foooooooooooooooooooooooo + foooooooooooooooo + fooooooooooooooo +;; + +let _ = + ! + (*a*) + (*b*) + x +;; + +let _ = + (*x*) + ! + (*a*) + (*b*) + x + (*c*) y +;; + +let _ = + f + ((*x*) + ! + (*a*) + (*b*) + x + (*c*) y) + y +;; + +type a = b (* a *) as (* b *) 'c (* c *) + +type t = + { (* comment before mutable *) + mutable + (* really long comment that doesn't fit on the same line as other stuff *) + x : + int + } + +let _ = (x + y) [@attr] + z +let _ = x ^ (y ^ z) [@attr] + +let _ = + (); + (* indentation preserved + *) + (); + (* indentation preserved + *) + (); + (* indentation preserved + *) + (); + (* indentation not preserved + *) + () +;; + +let vexpr (*aa*) (type (*bb*) a) (*cc*) (type (*dd*) b) (*ee*) : _ -> _ = k diff --git a/test/passing/refs.janestreet/comments.mli.ref b/test/passing/refs.janestreet/comments.mli.ref new file mode 100644 index 0000000000..1ffa83a75f --- /dev/null +++ b/test/passing/refs.janestreet/comments.mli.ref @@ -0,0 +1,7 @@ +(** docstring *) +val f : unit +(* comment *) + +(** docstring *) +val g : unit +(* comment *) diff --git a/test/passing/refs.janestreet/comments_args.ml.ref b/test/passing/refs.janestreet/comments_args.ml.ref new file mode 100644 index 0000000000..384c8217d1 --- /dev/null +++ b/test/passing/refs.janestreet/comments_args.ml.ref @@ -0,0 +1,35 @@ +[@@@ocamlformat "wrap-fun-args=true"] + +let emit_wrapper_function = + Hhas_function.make function_attributes name body + (Hhas_pos.pos_to_span ast_fun.Ast.f_span) + false (* is_async *) + false (* is_generator *) + false (* is_pair_generator *) + hoisted true (* no_injection *) + true (* inout_wrapper *) + is_interceptable false + (* is_memoize_impl *) + Rx.NonRx false +;; + +[@@@ocamlformat "wrap-fun-args=false"] + +let emit_wrapper_function = + Hhas_function.make + function_attributes + name + body + (Hhas_pos.pos_to_span ast_fun.Ast.f_span) + false (* is_async *) + false (* is_generator *) + false (* is_pair_generator *) + hoisted + true (* no_injection *) + true (* inout_wrapper *) + is_interceptable + false + (* is_memoize_impl *) + Rx.NonRx + false +;; diff --git a/test/passing/refs.janestreet/comments_around_disabled.ml.ref b/test/passing/refs.janestreet/comments_around_disabled.ml.ref new file mode 100644 index 0000000000..5699506abc --- /dev/null +++ b/test/passing/refs.janestreet/comments_around_disabled.ml.ref @@ -0,0 +1,16 @@ +(* cmts *) + +[@@@ocamlformat "disable"] +let () = + () +[@@@ocamlformat "enable"] + +[@@@ocamlformat "disable"] + (* x *) + (* y *) +let x = + x +(* z *) +[@@@ocamlformat "enable"] + +(* cmts *) diff --git a/test/passing/refs.janestreet/comments_in_local_let.ml.ref b/test/passing/refs.janestreet/comments_in_local_let.ml.ref new file mode 100644 index 0000000000..caada83df5 --- /dev/null +++ b/test/passing/refs.janestreet/comments_in_local_let.ml.ref @@ -0,0 +1,12 @@ +let _ = + (* a *) + let _ = + (* b *) + foo + (* c *) + (* d *) + in + (* e *) + () +;; +(* f *) diff --git a/test/passing/refs.janestreet/comments_in_record-break_separator-after.ml.err b/test/passing/refs.janestreet/comments_in_record-break_separator-after.ml.err new file mode 100644 index 0000000000..2fe50ead8b --- /dev/null +++ b/test/passing/refs.janestreet/comments_in_record-break_separator-after.ml.err @@ -0,0 +1,2 @@ +Warning: comments_in_record-break_separator-after.ml:50 exceeds the margin +Warning: comments_in_record-break_separator-after.ml:52 exceeds the margin diff --git a/test/passing/refs.janestreet/comments_in_record-break_separator-after.ml.ref b/test/passing/refs.janestreet/comments_in_record-break_separator-after.ml.ref new file mode 100644 index 0000000000..f19acbe818 --- /dev/null +++ b/test/passing/refs.janestreet/comments_in_record-break_separator-after.ml.ref @@ -0,0 +1,137 @@ +type t = + { a : int; (* some comment *) + b : float; + c : string; + d : [ `something_looooooooooooooooooooooooooooooooong ] + } + +type t = + { a : int; (** some comment *) + b : float; + c : string; + d : [ `something_looooooooooooooooooooooooooooooooong ] + } + +type t = + { a : int; (* Comment *) + b : int (* Comment *) + } + +type t = + { a : int; (* Comment *) + b : int (* Comment *) + } +[@@ocamlformat "type-decl=sparse"] + +let { (* cmts *) + pat; + loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong; + a; + (* b *) b; + (* c *) c; + d = + (* d *) + (D : loooooooooooooooooooooooooooooooooooooooooooooooooooooooong_int); + (* e *) + e : loooooooooooooooooooooooooooooooooooooooooooooooooooooooong_int + } + = + exp +;; + +let x = + { (* Xxxx xxxxxxxx xxxxx xx xx xx xxxx xxxxxx - XXxx_xxxxx xxx'x. *) + Irure_sed_a.in_nisi_sed = Irure_sed_fugiat.LaboRum sint_sed; + in_ea_deserunt = nulla + } +;; + +type t = + { a : int option; + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) + b : float + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) + } + +type t = + | Tuple of + { elts : t vector; + packed : bool + } + | Struct of + { name : string; + elts : t vector (* possibly cyclic, name unique *); + [@compare.ignore] [@equal.ignore] [@sexp_drop_if fun _ -> true] + elts : t vector; + (* possibly cyclic, name unique *) + (* mooooooooooooooooooooooooooooooooooore comments *) + [@compare.ignore] + [@equal.ignore] + [@sexp_drop_if fun _ -> true] + packed : bool + } + | Opaque of { name : string } +[@@deriving compare, equal, hash, sexp] + +type t = { (* c *) c (* c' *) : (* d *) d (* d' *) } + +let _ = + { (* a *) a (* a' *) = (* b *) b (* b' *); + (* c *) c (* c' *) : (* d *) d (* d' *) = (* e *) e (* e' *); + (* f *) f (* f' *); + (* g *) g (* g' *) = (* j *) ((* h *) h (* h' *) : (* i *) i (* i' *)) (* j' *) + } +;; + +let { (* a *) a (* a' *) = (* b *) b (* b' *); + (* c *) c (* c' *) : (* d *) d (* d' *) = (* e *) e (* e' *); + (* f *) f (* f' *); + (* g *) g (* g' *) = (* j *) ((* h *) h (* h' *) : (* i *) i (* i' *)) (* j' *) + } + = + x +;; + +type program = + { prog_globals : global list; (* global variables *) + prog_struct_types : lltype list; (* data structures *) + prog_lib_funcs : func list (* library functions *) + } + +type t = + { mutable ci_fixed : IntervalSet.t; + mutable ci_spilled : + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) + IntervalSet.t + } + +type t = + { mutable ci_fixed : IntervalSet.t; + mutable + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) + ci_spilled : + IntervalSet.t + } + +type t = + { mutable ci_fixed : IntervalSet.t; + mutable ci_spilled + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) : + IntervalSet.t + } + +let _ = + match c with + | { issuer = _; + (* TODO *) + _ + } -> () + | { issuer = _; (* TODO *) _ } -> () + | { issuer = _; _ (* TODO *) } -> () + | { issuer = _; + (* TODO *) + _ + (* TODO *) + } -> () + | { issuer = _; (* TODO *) _ (* TODO *) } -> () +;; diff --git a/test/passing/refs.janestreet/comments_in_record-break_separator-before.ml.err b/test/passing/refs.janestreet/comments_in_record-break_separator-before.ml.err new file mode 100644 index 0000000000..80cc3d4acf --- /dev/null +++ b/test/passing/refs.janestreet/comments_in_record-break_separator-before.ml.err @@ -0,0 +1,2 @@ +Warning: comments_in_record-break_separator-before.ml:50 exceeds the margin +Warning: comments_in_record-break_separator-before.ml:52 exceeds the margin diff --git a/test/passing/refs.janestreet/comments_in_record-break_separator-before.ml.ref b/test/passing/refs.janestreet/comments_in_record-break_separator-before.ml.ref new file mode 100644 index 0000000000..91044122b0 --- /dev/null +++ b/test/passing/refs.janestreet/comments_in_record-break_separator-before.ml.ref @@ -0,0 +1,137 @@ +type t = + { a : int (* some comment *) + ; b : float + ; c : string + ; d : [ `something_looooooooooooooooooooooooooooooooong ] + } + +type t = + { a : int (** some comment *) + ; b : float + ; c : string + ; d : [ `something_looooooooooooooooooooooooooooooooong ] + } + +type t = + { a : int (* Comment *) + ; b : int (* Comment *) + } + +type t = + { a : int (* Comment *) + ; b : int (* Comment *) + } +[@@ocamlformat "type-decl=sparse"] + +let { (* cmts *) + pat + ; loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong + ; a + ; (* b *) b + ; (* c *) c + ; d = + (* d *) + (D : loooooooooooooooooooooooooooooooooooooooooooooooooooooooong_int) + ; (* e *) + e : loooooooooooooooooooooooooooooooooooooooooooooooooooooooong_int + } + = + exp +;; + +let x = + { (* Xxxx xxxxxxxx xxxxx xx xx xx xxxx xxxxxx - XXxx_xxxxx xxx'x. *) + Irure_sed_a.in_nisi_sed = Irure_sed_fugiat.LaboRum sint_sed + ; in_ea_deserunt = nulla + } +;; + +type t = + { a : int option + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) + ; b : float + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) + } + +type t = + | Tuple of + { elts : t vector + ; packed : bool + } + | Struct of + { name : string + ; elts : t vector (* possibly cyclic, name unique *) + [@compare.ignore] [@equal.ignore] [@sexp_drop_if fun _ -> true] + ; elts : t vector + (* possibly cyclic, name unique *) + (* mooooooooooooooooooooooooooooooooooore comments *) + [@compare.ignore] + [@equal.ignore] + [@sexp_drop_if fun _ -> true] + ; packed : bool + } + | Opaque of { name : string } +[@@deriving compare, equal, hash, sexp] + +type t = { (* c *) c (* c' *) : (* d *) d (* d' *) } + +let _ = + { (* a *) a (* a' *) = (* b *) b (* b' *) + ; (* c *) c (* c' *) : (* d *) d (* d' *) = (* e *) e (* e' *) + ; (* f *) f (* f' *) + ; (* g *) g (* g' *) = (* j *) ((* h *) h (* h' *) : (* i *) i (* i' *)) (* j' *) + } +;; + +let { (* a *) a (* a' *) = (* b *) b (* b' *) + ; (* c *) c (* c' *) : (* d *) d (* d' *) = (* e *) e (* e' *) + ; (* f *) f (* f' *) + ; (* g *) g (* g' *) = (* j *) ((* h *) h (* h' *) : (* i *) i (* i' *)) (* j' *) + } + = + x +;; + +type program = + { prog_globals : global list (* global variables *) + ; prog_struct_types : lltype list (* data structures *) + ; prog_lib_funcs : func list (* library functions *) + } + +type t = + { mutable ci_fixed : IntervalSet.t + ; mutable ci_spilled : + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) + IntervalSet.t + } + +type t = + { mutable ci_fixed : IntervalSet.t + ; mutable + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) + ci_spilled : + IntervalSet.t + } + +type t = + { mutable ci_fixed : IntervalSet.t + ; mutable ci_spilled + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) : + IntervalSet.t + } + +let _ = + match c with + | { issuer = _ + ; (* TODO *) + _ + } -> () + | { issuer = _; (* TODO *) _ } -> () + | { issuer = _; _ (* TODO *) } -> () + | { issuer = _ + ; (* TODO *) + _ + (* TODO *) + } -> () + | { issuer = _; (* TODO *) _ (* TODO *) } -> () +;; diff --git a/test/passing/refs.janestreet/comments_in_record.ml.err b/test/passing/refs.janestreet/comments_in_record.ml.err new file mode 100644 index 0000000000..4032edeeb9 --- /dev/null +++ b/test/passing/refs.janestreet/comments_in_record.ml.err @@ -0,0 +1,2 @@ +Warning: comments_in_record.ml:50 exceeds the margin +Warning: comments_in_record.ml:52 exceeds the margin diff --git a/test/passing/refs.janestreet/comments_in_record.ml.ref b/test/passing/refs.janestreet/comments_in_record.ml.ref new file mode 100644 index 0000000000..91044122b0 --- /dev/null +++ b/test/passing/refs.janestreet/comments_in_record.ml.ref @@ -0,0 +1,137 @@ +type t = + { a : int (* some comment *) + ; b : float + ; c : string + ; d : [ `something_looooooooooooooooooooooooooooooooong ] + } + +type t = + { a : int (** some comment *) + ; b : float + ; c : string + ; d : [ `something_looooooooooooooooooooooooooooooooong ] + } + +type t = + { a : int (* Comment *) + ; b : int (* Comment *) + } + +type t = + { a : int (* Comment *) + ; b : int (* Comment *) + } +[@@ocamlformat "type-decl=sparse"] + +let { (* cmts *) + pat + ; loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong + ; a + ; (* b *) b + ; (* c *) c + ; d = + (* d *) + (D : loooooooooooooooooooooooooooooooooooooooooooooooooooooooong_int) + ; (* e *) + e : loooooooooooooooooooooooooooooooooooooooooooooooooooooooong_int + } + = + exp +;; + +let x = + { (* Xxxx xxxxxxxx xxxxx xx xx xx xxxx xxxxxx - XXxx_xxxxx xxx'x. *) + Irure_sed_a.in_nisi_sed = Irure_sed_fugiat.LaboRum sint_sed + ; in_ea_deserunt = nulla + } +;; + +type t = + { a : int option + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) + ; b : float + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) + } + +type t = + | Tuple of + { elts : t vector + ; packed : bool + } + | Struct of + { name : string + ; elts : t vector (* possibly cyclic, name unique *) + [@compare.ignore] [@equal.ignore] [@sexp_drop_if fun _ -> true] + ; elts : t vector + (* possibly cyclic, name unique *) + (* mooooooooooooooooooooooooooooooooooore comments *) + [@compare.ignore] + [@equal.ignore] + [@sexp_drop_if fun _ -> true] + ; packed : bool + } + | Opaque of { name : string } +[@@deriving compare, equal, hash, sexp] + +type t = { (* c *) c (* c' *) : (* d *) d (* d' *) } + +let _ = + { (* a *) a (* a' *) = (* b *) b (* b' *) + ; (* c *) c (* c' *) : (* d *) d (* d' *) = (* e *) e (* e' *) + ; (* f *) f (* f' *) + ; (* g *) g (* g' *) = (* j *) ((* h *) h (* h' *) : (* i *) i (* i' *)) (* j' *) + } +;; + +let { (* a *) a (* a' *) = (* b *) b (* b' *) + ; (* c *) c (* c' *) : (* d *) d (* d' *) = (* e *) e (* e' *) + ; (* f *) f (* f' *) + ; (* g *) g (* g' *) = (* j *) ((* h *) h (* h' *) : (* i *) i (* i' *)) (* j' *) + } + = + x +;; + +type program = + { prog_globals : global list (* global variables *) + ; prog_struct_types : lltype list (* data structures *) + ; prog_lib_funcs : func list (* library functions *) + } + +type t = + { mutable ci_fixed : IntervalSet.t + ; mutable ci_spilled : + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) + IntervalSet.t + } + +type t = + { mutable ci_fixed : IntervalSet.t + ; mutable + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) + ci_spilled : + IntervalSet.t + } + +type t = + { mutable ci_fixed : IntervalSet.t + ; mutable ci_spilled + (* spilled stack slots (reg.loc = Stack (Local n)) still in use *) : + IntervalSet.t + } + +let _ = + match c with + | { issuer = _ + ; (* TODO *) + _ + } -> () + | { issuer = _; (* TODO *) _ } -> () + | { issuer = _; _ (* TODO *) } -> () + | { issuer = _ + ; (* TODO *) + _ + (* TODO *) + } -> () + | { issuer = _; (* TODO *) _ (* TODO *) } -> () +;; diff --git a/test/passing/refs.janestreet/crlf_to_crlf.ml.ref b/test/passing/refs.janestreet/crlf_to_crlf.ml.ref new file mode 100644 index 0000000000..7c9b8e516b --- /dev/null +++ b/test/passing/refs.janestreet/crlf_to_crlf.ml.ref @@ -0,0 +1,43 @@ +let _ = + {| +foo + + bar +|} +;; + +(** This is verbatim: + + {v + o o + /\ /\ + /\ /\ + v} + + This is preformated code: + + {[ + let verbatim s = + s |> String.split_lines |> List.map ~f:String.strip + |> fun s -> list s "@," Fmt.str + ]} *) + +(** Lists: + + list with short lines: + + - x + + list with long lines: + + - xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx + xxx xxx xxx xxx xxx xxx + + list with sub lists: + + {ul + {- xxx + + - a + } + } *) diff --git a/test/passing/refs.janestreet/crlf_to_lf.ml.ref b/test/passing/refs.janestreet/crlf_to_lf.ml.ref new file mode 100644 index 0000000000..da68eee407 --- /dev/null +++ b/test/passing/refs.janestreet/crlf_to_lf.ml.ref @@ -0,0 +1,43 @@ +let _ = + {| +foo + + bar +|} +;; + +(** This is verbatim: + + {v + o o + /\ /\ + /\ /\ + v} + + This is preformated code: + + {[ + let verbatim s = + s |> String.split_lines |> List.map ~f:String.strip + |> fun s -> list s "@," Fmt.str + ]} *) + +(** Lists: + + list with short lines: + + - x + + list with long lines: + + - xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx + xxx xxx xxx xxx xxx xxx + + list with sub lists: + + {ul + {- xxx + + - a + } + } *) diff --git a/test/passing/refs.janestreet/custom_list.ml.ref b/test/passing/refs.janestreet/custom_list.ml.ref new file mode 100644 index 0000000000..b47198ae24 --- /dev/null +++ b/test/passing/refs.janestreet/custom_list.ml.ref @@ -0,0 +1,5 @@ +type 'a t = + | [] + | ( :: ) of 'a * 'a t + +let _ = ( :: ) 5 diff --git a/test/passing/refs.janestreet/directives.mlt.ref b/test/passing/refs.janestreet/directives.mlt.ref new file mode 100644 index 0000000000..35797a12e8 --- /dev/null +++ b/test/passing/refs.janestreet/directives.mlt.ref @@ -0,0 +1,7 @@ +(* comment before *) +#directory "+unix" + +#load (* a *) "file" +(* b *) + +(* comment after *) diff --git a/test/passing/refs.janestreet/disable_attr.ml.ref b/test/passing/refs.janestreet/disable_attr.ml.ref new file mode 100644 index 0000000000..e7671a5070 --- /dev/null +++ b/test/passing/refs.janestreet/disable_attr.ml.ref @@ -0,0 +1,4 @@ +[@@@ocamlformat "disable"] + +(** hello *) +let foo = 42 diff --git a/test/passing/refs.janestreet/disable_class_type.ml.ref b/test/passing/refs.janestreet/disable_class_type.ml.ref new file mode 100644 index 0000000000..d6021357ba --- /dev/null +++ b/test/passing/refs.janestreet/disable_class_type.ml.ref @@ -0,0 +1,8 @@ +class type c = + let open [@ocamlformat "disable"] Z + in +z + +class type c = + object [@ocamlformat "disable"] + end diff --git a/test/passing/refs.janestreet/disable_conf_attrs.ml.err b/test/passing/refs.janestreet/disable_conf_attrs.ml.err new file mode 100644 index 0000000000..f0b6ca23b5 --- /dev/null +++ b/test/passing/refs.janestreet/disable_conf_attrs.ml.err @@ -0,0 +1,40 @@ +File "disable_conf_attrs.ml", line 3, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 3, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 5, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 5, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 7, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 7, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 9, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 9, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 11, characters 18-33: +Warning: Configuration in attribute "break-cases=all" ignored. +File "disable_conf_attrs.ml", line 11, characters 18-33: +Warning: Configuration in attribute "break-cases=all" ignored. +File "disable_conf_attrs.ml", line 2, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 2, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 3, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 3, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 4, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 4, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 5, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 5, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 7, characters 18-33: +Warning: Configuration in attribute "break-cases=all" ignored. +File "disable_conf_attrs.ml", line 7, characters 18-33: +Warning: Configuration in attribute "break-cases=all" ignored. diff --git a/test/passing/refs.janestreet/disable_conf_attrs.ml.ref b/test/passing/refs.janestreet/disable_conf_attrs.ml.ref new file mode 100644 index 0000000000..89f6f168cf --- /dev/null +++ b/test/passing/refs.janestreet/disable_conf_attrs.ml.ref @@ -0,0 +1,10 @@ +let a, b = 1, 2 +let[@ocamlformat "parens-tuple-patterns=always"] a, b = 1, 2 +let[@ocamlformat "parens-tuple-patterns=always"] M.(a, b) = () +let[@ocamlformat "parens-tuple-patterns=multi-line-only"] a, b = 1, 2 +let[@ocamlformat "parens-tuple-patterns=multi-line-only"] M.(a, b) = () + +let[@ocamlformat "break-cases=all"] _ = + try () with + | End_of_file | Not_found -> () +;; diff --git a/test/passing/refs.janestreet/disable_local_let.ml.ref b/test/passing/refs.janestreet/disable_local_let.ml.ref new file mode 100644 index 0000000000..30fc5d993e --- /dev/null +++ b/test/passing/refs.janestreet/disable_local_let.ml.ref @@ -0,0 +1,37 @@ +let f () = + let [@ocamlformat "disable"] x = y + in + () +;; + +let f () = + let x = y [@@ocamlformat "disable"] + in + () +;; + +let f () = let open [@ocamlformat "disable"] X + in + () + +let f () = let module [@ocamlformat "disable"] X = Y + in + () + +let f () = let exception [@ocamlformat "disable"] X + in + () + +class c = let open [@ocamlformat "disable"] X + in + x + +class c = + let [@ocamlformat "disable"] x = y + in + object end + +class type c = + let open [@ocamlformat "disable"] X + in + x diff --git a/test/passing/refs.janestreet/disabled.ml.ref b/test/passing/refs.janestreet/disabled.ml.ref new file mode 100644 index 0000000000..31e753ef30 --- /dev/null +++ b/test/passing/refs.janestreet/disabled.ml.ref @@ -0,0 +1,2 @@ +(* this file does not parse and ocamlformat is disabled *) +let = in diff --git a/test/passing/refs.janestreet/disabled_attr.ml.ref b/test/passing/refs.janestreet/disabled_attr.ml.ref new file mode 100644 index 0000000000..3d22fb9a4e --- /dev/null +++ b/test/passing/refs.janestreet/disabled_attr.ml.ref @@ -0,0 +1,24 @@ +let _ = + let disabled = {| + |}[@ocamlformat "disable"] in + () +;; + +let _ = + let disabled = " + "[@ocamlformat "disable"] in + () +;; + +let _ = + let disabled = + begin + (* xxx + + xxx *) + + y + end[@ocamlformat "disable"] + in + () +;; diff --git a/test/passing/refs.janestreet/disambiguate.ml.ref b/test/passing/refs.janestreet/disambiguate.ml.ref new file mode 100644 index 0000000000..cfab18db5e --- /dev/null +++ b/test/passing/refs.janestreet/disambiguate.ml.ref @@ -0,0 +1,95 @@ +[@@@ocamlformat "disambiguate-non-breaking-match"] + +let () = + r + := fun () -> + f (); + g () +;; + +let () = + r + := fun () -> + f (); + g (); + g (); + g (); + g (); + g (); + g (); + g (); + g (); + g () +;; + +let () = + r + := function + | () -> + f (); + g () +;; + +let () = + r + := function + | () -> + f (); + g (); + g (); + g (); + g (); + g (); + g (); + g (); + g (); + g () +;; + +let () = + r + := match () with + | () -> + f (); + g () +;; + +let () = + r + := match () with + | () -> + f (); + g (); + g (); + g (); + g (); + g (); + g (); + g (); + g (); + g () +;; + +let () = + r + := try () with + | () -> + f (); + g () +;; + +let () = + r + := try () with + | () -> + f (); + g (); + g (); + g (); + g (); + g (); + g (); + g (); + g (); + g () +;; diff --git a/test/passing/refs.janestreet/disambiguated_types.ml.ref b/test/passing/refs.janestreet/disambiguated_types.ml.ref new file mode 100644 index 0000000000..11ae25cdad --- /dev/null +++ b/test/passing/refs.janestreet/disambiguated_types.ml.ref @@ -0,0 +1,3 @@ +let t : int = 4 +let x : t/2 = t / 2 +let x : foo M/2.e0 e/2 = foo M / 2.e0 diff --git a/test/passing/refs.janestreet/doc.mld.err b/test/passing/refs.janestreet/doc.mld.err new file mode 100644 index 0000000000..9197fe8fc5 --- /dev/null +++ b/test/passing/refs.janestreet/doc.mld.err @@ -0,0 +1,8 @@ +Warning: doc.mld:1 exceeds the margin +Warning: doc.mld:9 exceeds the margin +Warning: doc.mld:11 exceeds the margin +Warning: doc.mld:12 exceeds the margin +Warning: doc.mld:13 exceeds the margin +Warning: doc.mld:14 exceeds the margin +Warning: doc.mld:16 exceeds the margin +Warning: doc.mld:92 exceeds the margin diff --git a/test/passing/refs.janestreet/doc.mld.ref b/test/passing/refs.janestreet/doc.mld.ref new file mode 100644 index 0000000000..2f01623204 --- /dev/null +++ b/test/passing/refs.janestreet/doc.mld.ref @@ -0,0 +1,156 @@ +{0 Parent/Child Specification} +This parent/child specification allows more flexible output support, e.g., per library documentation. See {{:https://v3.ocaml.org/packages}v3.ocaml.org/packages}. + +The rules are; + +- [.mld] files may or may not have a parent [.mld]. +- Compilation units must have a parent [.mld]. +- The parent [.mld] file must be compiled before any of its children, and the children + must be specified at the parent's compilation time. +- The output paths of [.mld] files and compilation units are subdirectories of their parent's + output directory. +- The output directory of a [.mld] file [x.mld] with children is [<parent_output_directory>/x], + and its file name is [index.html]. That is to say, [<parent_output_directory>/x/index.html] +- The output directory of a [.mld] file [x.mld] without children is [<parent_output_directory> /x.html] +- The output directory of a compilation unit [X] is [<parent_output_directory>/X/index.html] + +{b Note:} The [--pkg <package>] option is still supported for backward compatibility in [odoc >= v2.0.0], +although it's now equivalent to specifying a parent [.mld] file. + +For example, let's consider [John] whose is [Doe] and [Mark]'s father. [Doe] has +children, [Max], and page [foo], whereas [Mark] has no children. That is to say, +[john.mld], [doe.mld], [mark.mld], [max.mld], [foo.ml] respectively. For instance; + +[john.mld] + +{v +{0 About John} + +I'm John the father to {{!page-doe}Doe} and {{!page-mark}Mark}. +v} + +[doe.mld] + +{v +{0 About Doe} + +I'm Doe, the; +- son to {{!page-john}John} +- brother to {{!page-mark}Mark} +- father to {{!page-max}Max} + +I also own page {{!page-foo}foo} +v} + +[mark.mld] + +{v +{0 About Mark} + +I'm Mark {{!page-doe}Doe}'s brother and I have no children. +v} + +[max.mld] + +{v +{0 About Max} + +I'm Max, the child to {{!page-doe}Doe} +v} + +[foo.ml] + +{[ + (** I'm foo, a page child to Doe *) +]} + +{2 Compilation} + +{v +$ ocamlc -c -bin-annot foo.ml + && odoc compile john.mld -c page-doe -c page-mark + && odoc compile doe.mld -I . --parent page-john -c page-max -c foo + && odoc compile max.mld -I . --parent page-doe + && odoc compile foo.cmt -I . --parent page-doe + && odoc compile mark.mld -I . --parent page-john +v} + +The output of the compilation phase will be [.odoc] files, where each will be +linked by invoking the [odoc link] command on them. + +{2 Linking} + +[odoc link -I . <file>.odoc] + +{v +$ odoc link -I . page-john.odoc + && odoc link -I . page-doe.odoc + && odoc link -I . page-mark.odoc + && odoc link -I . page-max.odoc + && odoc link -I . foo.odoc +v} + +The output of the [odoc link] command is an [.odocl] file, by default, in the same path as the original [.odoc] file. + +{2 Generating HTML} +{v +$ odoc html-generate --indent -o html page-john.odocl + && odoc html-generate --indent -o html page-doe.odocl + && odoc html-generate --indent -o html page-mark.odocl + && odoc html-generate --indent -o html page-max.odocl + && odoc html-generate --indent -o html foo.odocl + && odoc support-files -o html +v} + +Then we inspect the contents of the [html] directory using; + +{v +$ ls -R html + highlight.pack.js + john + odoc.css + + html/john: + doe + index.html + mark.html + + html/john/doe: + Foo + index.html + max.html + + html/john/doe/Foo: + index. +v} + +{b Note:} We generated HTML files only for this example, but it's very possible to +generate files in other formats (i.e, latex and man-pages) using: + +- [$ odoc latex-generate -o latex <file>.odocl] +- [$ odoc man-generate -o man <file>.odocl] + +Of course there are different commands that [odoc] uses for other purposes; e.g., +for inspection: + +- [odoc <html/latex/man>-targets ...] takes a glimpse of the expected targets +- [odoc compile-deps ...] lists units (with their digest) that need to be + compiled in order to compile the current compilation unit. The unit itself and its + digest is also reported in the output. + +For example, inspecting the dependencies required to compile [foo.cmt], we run + +[odoc compile-deps foo.cmt] + +and we shall get + +{[ + Stdlib aea3513d44d604b62eaff79ad12007b3 + Foo x5ab79b5411a3c3476029260eda0b4a26 + CamlinternalFormatBasics f562e7b79dbe1bb1591060d6b4e854cf +]} + +For more about [odoc] commands, simply invoke [odoc --help] in your shell. + +Preserve the space between a link/reference and its text: +{{:foo}bar} {{:foo} bar} {{!foo}bar} {{!foo} bar} diff --git a/test/passing/refs.janestreet/doc_comments-after.ml.err b/test/passing/refs.janestreet/doc_comments-after.ml.err new file mode 100644 index 0000000000..edab2da9d9 --- /dev/null +++ b/test/passing/refs.janestreet/doc_comments-after.ml.err @@ -0,0 +1,4 @@ +Warning: doc_comments-after.ml:258 exceeds the margin +Warning: doc_comments-after.ml:259 exceeds the margin +Warning: doc_comments-after.ml:260 exceeds the margin +Warning: doc_comments-after.ml:289 exceeds the margin diff --git a/test/passing/refs.janestreet/doc_comments-after.ml.ref b/test/passing/refs.janestreet/doc_comments-after.ml.ref new file mode 100644 index 0000000000..9a58efeb42 --- /dev/null +++ b/test/passing/refs.janestreet/doc_comments-after.ml.ref @@ -0,0 +1,308 @@ +module A = B +(** test *) + +include A (** @open *) + +include B (** @open *) + +include A + +type t = C of int (** docstring comment *) +type t = C of int [@ocaml.doc " docstring attribute "] + +include Mod +(** comment *) + +(** before *) +let x = 2 +(** after *) + +(**floatting1*) +(**floatting2*) + +(**before*) +and y = 2 +(** after *) + +(** A *) +let a = 0 +(** A' *) + +module Comment_placement : sig + type t + (** Type *) + + (** Variant declaration *) + type t = T + + (** Type extension *) + type t += T + + module A : B + (** Module *) + + (** Module *) + module A : sig + type a + type b + end + + val a : b + (** Val *) + + exception E + (** Exception *) + + include M + (** Include *) + + (** Include *) + include sig + type a + type b + end + + open M + (** Open *) + + external a : b = "c" + (** External *) + + module rec A : B + (** Rec module *) + + (** Rec module *) + module rec A : sig + type a + type b + end + + module type A + (** Module type *) + + (** Module type *) + module type A = sig + type a + type b + end + + class a : b + (** Class *) + + class type a = b + (** Class type *) + + (* [@@@some attribute] *) + (* (** Attribute *) *) + + [%%some extension] + (** Extension *) + + (** A *) + external a : b = "double_comment" + (** B *) + + (** This comment goes before *) + module S_ext : sig + type t + end + + module Index : Index.S + (** This one goes after *) + + (** This one _still_ goes after *) + module Index2 + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end + + (** Doc comment still goes after *) + module Make (Config : sig + val blah : string + + (* this could be a really long signature *) + end) : S + + module Gen () : S + (** Generative functor *) +end = struct + type t = { a : int } + (** Type *) + + (** Variant declaration *) + type t = T + + (** Type extension *) + type t += T + + module A = B + (** Module *) + + (** Module *) + module A = struct + type a = A + type b = B + end + + (** Module *) + module A : sig + type a + type b + end = + B + + (** Let *) + let a = b + + exception E + (** Exception *) + + include M + (** Include *) + + (** Include *) + include struct + type a = A + type b = B + end + + open M + (** Open *) + + external a : b = "c" + (** External *) + + module rec A : B = C + (** Rec module *) + + (** Rec module *) + module rec A : B = struct + type a = A + type b = B + end + + module type A = B + (** Module type *) + + (** Module type *) + module type A = sig + type a + type b + end + + class a = b + (** Class *) + + (** Class *) + class b = + object + method f = 0 + (** Method *) + + inherit a + (** Inherit *) + + val x = 1 + (** Val *) + + constraint 'a = [> ] + (** Constraint *) + + initializer do_init () + (** Initialiser *) + end + + class type a = b + (** Class type *) + + (* [@@@some attribute] *) + (* (** Attribute *) *) + + [%%some extension] + (** Extension *) + + (* ;; *) + (* (** Eval *) *) + (* 1 + 1 *) + (* ;; *) + + (** A *) + external a : b = "double_comment" + (** B *) +end + +(** A *) +exception A of int +(** C *) + +(** {1:lbl Heading} *) + +(** {2 heading without label} *) + +module A = struct + module B = struct + (** It does not try to saturate + (1a) A = B + C /\ B = D + E => A = C + D + E + Nor combine more than 2 equations + (1b) A = B + C /\ B = D + E /\ F = C + D + E => A = F + + xxxxxxxxxxxxxxxxxxxxxxxxxxxx + (2) A = B + C /\ B = D + E => A = C + D - E + *) + let a b = () + end +end + +(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident, +* we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before +* processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *) +let _ = () + +(** Tags without text *) + +(** @see <Abc> *) + +(** @before a *) + +(** @deprecated *) + +(** @param b *) + +(** @raise c *) + +(** @return *) + +(** @see 'file' *) + +(** @see "title" *) + +(** + +starts with linebreaks +*) +let a = 1 + +(** {@metadata[ Code block with metadata field ]} *) + +(** {@some_tag[ Code block with metadata field. This is a big block that should hopefully break ]} *) + +(** {@ocaml[ + let _ = + f + @@ + { aaa= aaa bbb ccc + ; bbb= aaa bbb ccc + ; ccc= aaa bbb ccc } + >>= fun () -> + let _ = x in + f @@ g @@ h @@ fun x -> y + ]} *) + +(**{v + + foo + +v}*) diff --git a/test/passing/refs.janestreet/doc_comments-before-except-val.ml.err b/test/passing/refs.janestreet/doc_comments-before-except-val.ml.err new file mode 100644 index 0000000000..9bc71e1a31 --- /dev/null +++ b/test/passing/refs.janestreet/doc_comments-before-except-val.ml.err @@ -0,0 +1,4 @@ +Warning: doc_comments-before-except-val.ml:258 exceeds the margin +Warning: doc_comments-before-except-val.ml:259 exceeds the margin +Warning: doc_comments-before-except-val.ml:260 exceeds the margin +Warning: doc_comments-before-except-val.ml:289 exceeds the margin diff --git a/test/passing/refs.janestreet/doc_comments-before-except-val.ml.ref b/test/passing/refs.janestreet/doc_comments-before-except-val.ml.ref new file mode 100644 index 0000000000..2abd4f6bad --- /dev/null +++ b/test/passing/refs.janestreet/doc_comments-before-except-val.ml.ref @@ -0,0 +1,308 @@ +(** test *) +module A = B + +include A (** @open *) + +include B (** @open *) + +include A + +type t = C of int (** docstring comment *) +type t = C of int [@ocaml.doc " docstring attribute "] + +(** comment *) +include Mod + +(** before *) +let x = 2 +(** after *) + +(**floatting1*) +(**floatting2*) + +(**before*) +and y = 2 +(** after *) + +(** A *) +let a = 0 +(** A' *) + +module Comment_placement : sig + (** Type *) + type t + + (** Variant declaration *) + type t = T + + (** Type extension *) + type t += T + + (** Module *) + module A : B + + (** Module *) + module A : sig + type a + type b + end + + val a : b + (** Val *) + + (** Exception *) + exception E + + (** Include *) + include M + + (** Include *) + include sig + type a + type b + end + + (** Open *) + open M + + external a : b = "c" + (** External *) + + (** Rec module *) + module rec A : B + + (** Rec module *) + module rec A : sig + type a + type b + end + + (** Module type *) + module type A + + (** Module type *) + module type A = sig + type a + type b + end + + (** Class *) + class a : b + + (** Class type *) + class type a = b + + (* [@@@some attribute] *) + (* (** Attribute *) *) + + (** Extension *) + [%%some extension] + + (** A *) + external a : b = "double_comment" + (** B *) + + (** This comment goes before *) + module S_ext : sig + type t + end + + (** This one goes after *) + module Index : Index.S + + (** This one _still_ goes after *) + module Index2 + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end + + (** Doc comment still goes after *) + module Make (Config : sig + val blah : string + + (* this could be a really long signature *) + end) : S + + (** Generative functor *) + module Gen () : S +end = struct + (** Type *) + type t = { a : int } + + (** Variant declaration *) + type t = T + + (** Type extension *) + type t += T + + (** Module *) + module A = B + + (** Module *) + module A = struct + type a = A + type b = B + end + + (** Module *) + module A : sig + type a + type b + end = + B + + (** Let *) + let a = b + + (** Exception *) + exception E + + (** Include *) + include M + + (** Include *) + include struct + type a = A + type b = B + end + + (** Open *) + open M + + external a : b = "c" + (** External *) + + (** Rec module *) + module rec A : B = C + + (** Rec module *) + module rec A : B = struct + type a = A + type b = B + end + + (** Module type *) + module type A = B + + (** Module type *) + module type A = sig + type a + type b + end + + (** Class *) + class a = b + + (** Class *) + class b = + object + (** Method *) + method f = 0 + + (** Inherit *) + inherit a + + (** Val *) + val x = 1 + + (** Constraint *) + constraint 'a = [> ] + + (** Initialiser *) + initializer do_init () + end + + (** Class type *) + class type a = b + + (* [@@@some attribute] *) + (* (** Attribute *) *) + + (** Extension *) + [%%some extension] + + (* ;; *) + (* (** Eval *) *) + (* 1 + 1 *) + (* ;; *) + + (** A *) + external a : b = "double_comment" + (** B *) +end + +(** A *) +exception A of int +(** C *) + +(** {1:lbl Heading} *) + +(** {2 heading without label} *) + +module A = struct + module B = struct + (** It does not try to saturate + (1a) A = B + C /\ B = D + E => A = C + D + E + Nor combine more than 2 equations + (1b) A = B + C /\ B = D + E /\ F = C + D + E => A = F + + xxxxxxxxxxxxxxxxxxxxxxxxxxxx + (2) A = B + C /\ B = D + E => A = C + D - E + *) + let a b = () + end +end + +(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident, +* we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before +* processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *) +let _ = () + +(** Tags without text *) + +(** @see <Abc> *) + +(** @before a *) + +(** @deprecated *) + +(** @param b *) + +(** @raise c *) + +(** @return *) + +(** @see 'file' *) + +(** @see "title" *) + +(** + +starts with linebreaks +*) +let a = 1 + +(** {@metadata[ Code block with metadata field ]} *) + +(** {@some_tag[ Code block with metadata field. This is a big block that should hopefully break ]} *) + +(** {@ocaml[ + let _ = + f + @@ + { aaa= aaa bbb ccc + ; bbb= aaa bbb ccc + ; ccc= aaa bbb ccc } + >>= fun () -> + let _ = x in + f @@ g @@ h @@ fun x -> y + ]} *) + +(**{v + + foo + +v}*) diff --git a/test/passing/refs.janestreet/doc_comments-before.ml.err b/test/passing/refs.janestreet/doc_comments-before.ml.err new file mode 100644 index 0000000000..c1b82ef991 --- /dev/null +++ b/test/passing/refs.janestreet/doc_comments-before.ml.err @@ -0,0 +1,4 @@ +Warning: doc_comments-before.ml:258 exceeds the margin +Warning: doc_comments-before.ml:259 exceeds the margin +Warning: doc_comments-before.ml:260 exceeds the margin +Warning: doc_comments-before.ml:289 exceeds the margin diff --git a/test/passing/refs.janestreet/doc_comments-before.ml.ref b/test/passing/refs.janestreet/doc_comments-before.ml.ref new file mode 100644 index 0000000000..adf423ce45 --- /dev/null +++ b/test/passing/refs.janestreet/doc_comments-before.ml.ref @@ -0,0 +1,308 @@ +(** test *) +module A = B + +include A (** @open *) + +include B (** @open *) + +include A + +type t = C of int (** docstring comment *) +type t = C of int [@ocaml.doc " docstring attribute "] + +(** comment *) +include Mod + +(** before *) +let x = 2 +(** after *) + +(**floatting1*) +(**floatting2*) + +(**before*) +and y = 2 +(** after *) + +(** A *) +let a = 0 +(** A' *) + +module Comment_placement : sig + (** Type *) + type t + + (** Variant declaration *) + type t = T + + (** Type extension *) + type t += T + + (** Module *) + module A : B + + (** Module *) + module A : sig + type a + type b + end + + (** Val *) + val a : b + + (** Exception *) + exception E + + (** Include *) + include M + + (** Include *) + include sig + type a + type b + end + + (** Open *) + open M + + (** External *) + external a : b = "c" + + (** Rec module *) + module rec A : B + + (** Rec module *) + module rec A : sig + type a + type b + end + + (** Module type *) + module type A + + (** Module type *) + module type A = sig + type a + type b + end + + (** Class *) + class a : b + + (** Class type *) + class type a = b + + (* [@@@some attribute] *) + (* (** Attribute *) *) + + (** Extension *) + [%%some extension] + + (** A *) + external a : b = "double_comment" + (** B *) + + (** This comment goes before *) + module S_ext : sig + type t + end + + (** This one goes after *) + module Index : Index.S + + (** This one _still_ goes after *) + module Index2 + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end + + (** Doc comment still goes after *) + module Make (Config : sig + val blah : string + + (* this could be a really long signature *) + end) : S + + (** Generative functor *) + module Gen () : S +end = struct + (** Type *) + type t = { a : int } + + (** Variant declaration *) + type t = T + + (** Type extension *) + type t += T + + (** Module *) + module A = B + + (** Module *) + module A = struct + type a = A + type b = B + end + + (** Module *) + module A : sig + type a + type b + end = + B + + (** Let *) + let a = b + + (** Exception *) + exception E + + (** Include *) + include M + + (** Include *) + include struct + type a = A + type b = B + end + + (** Open *) + open M + + (** External *) + external a : b = "c" + + (** Rec module *) + module rec A : B = C + + (** Rec module *) + module rec A : B = struct + type a = A + type b = B + end + + (** Module type *) + module type A = B + + (** Module type *) + module type A = sig + type a + type b + end + + (** Class *) + class a = b + + (** Class *) + class b = + object + (** Method *) + method f = 0 + + (** Inherit *) + inherit a + + (** Val *) + val x = 1 + + (** Constraint *) + constraint 'a = [> ] + + (** Initialiser *) + initializer do_init () + end + + (** Class type *) + class type a = b + + (* [@@@some attribute] *) + (* (** Attribute *) *) + + (** Extension *) + [%%some extension] + + (* ;; *) + (* (** Eval *) *) + (* 1 + 1 *) + (* ;; *) + + (** A *) + external a : b = "double_comment" + (** B *) +end + +(** A *) +exception A of int +(** C *) + +(** {1:lbl Heading} *) + +(** {2 heading without label} *) + +module A = struct + module B = struct + (** It does not try to saturate + (1a) A = B + C /\ B = D + E => A = C + D + E + Nor combine more than 2 equations + (1b) A = B + C /\ B = D + E /\ F = C + D + E => A = F + + xxxxxxxxxxxxxxxxxxxxxxxxxxxx + (2) A = B + C /\ B = D + E => A = C + D - E + *) + let a b = () + end +end + +(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident, +* we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before +* processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *) +let _ = () + +(** Tags without text *) + +(** @see <Abc> *) + +(** @before a *) + +(** @deprecated *) + +(** @param b *) + +(** @raise c *) + +(** @return *) + +(** @see 'file' *) + +(** @see "title" *) + +(** + +starts with linebreaks +*) +let a = 1 + +(** {@metadata[ Code block with metadata field ]} *) + +(** {@some_tag[ Code block with metadata field. This is a big block that should hopefully break ]} *) + +(** {@ocaml[ + let _ = + f + @@ + { aaa= aaa bbb ccc + ; bbb= aaa bbb ccc + ; ccc= aaa bbb ccc } + >>= fun () -> + let _ = x in + f @@ g @@ h @@ fun x -> y + ]} *) + +(**{v + + foo + +v}*) diff --git a/test/passing/refs.janestreet/doc_comments-no-parse-docstrings.mli.err b/test/passing/refs.janestreet/doc_comments-no-parse-docstrings.mli.err new file mode 100644 index 0000000000..89f45515f2 --- /dev/null +++ b/test/passing/refs.janestreet/doc_comments-no-parse-docstrings.mli.err @@ -0,0 +1,13 @@ +Warning: doc_comments-no-parse-docstrings.mli:92 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:100 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:104 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:108 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:110 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:114 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:122 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:469 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:476 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:553 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:555 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:557 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:592 exceeds the margin diff --git a/test/passing/refs.janestreet/doc_comments-no-parse-docstrings.mli.ref b/test/passing/refs.janestreet/doc_comments-no-parse-docstrings.mli.ref new file mode 100644 index 0000000000..7a2e24644f --- /dev/null +++ b/test/passing/refs.janestreet/doc_comments-no-parse-docstrings.mli.ref @@ -0,0 +1,663 @@ +(** Manpages. See {!Cmdliner.Manpage}. *) + +type block = + [ `S of string + | `P of string + | `Pre of string + | `I of string * string + | `Noblank + | `Blocks of block list + ] + +(** Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod *) +include M with type t := t + +(** [escape s] escapes [s] from the doc language. *) +val escape : string -> string + +type title = string * int * string * string * string + +(** {1:standard-section-names Standard section names} *) + +val s_name : string + +(** {1:section-maps Section maps} + + Used for handling the merging of metadata doc strings. *) + +type smap + +(** [smap_append_block smap sec b] appends [b] at the end of section [sec] + creating it at the right place if needed. *) +val smap_append_block : smap -> sec:string -> block -> smap + +(** {1:content-boilerplate Content boilerplate} *) + +val s_environment_intro : block + +(** {1:output Output} *) + +type format = + [ `Auto + | `Pager + | `Plain + | `Groff + ] + +val print + : ?errs:Format.formatter + -> ?subst:(string -> string option) + -> format + -> Format.formatter + -> t + -> unit + +(** {1:printers-and-escapes-used-by-cmdliner-module Printers and escapes + used by Cmdliner module} *) + +(** [subst b ~subst s], using [b], substitutes in [s] variables of the form + "$(doc)" by their [subst] definition. This leaves escapes and markup + directives $(markup,...) intact. + + @raise Invalid_argument in case of illegal syntax. *) +val subst_vars + : errs:Format.formatter + -> subst:(string -> string option) + -> Buffer.t + -> string + -> string + +(** [doc_to_plain b ~subst s] using [b], subsitutes in [s] variables by + their [subst] definition and renders cmdliner directives to plain text. + + @raise Invalid_argument in case of illegal syntax. *) +val doc_to_plain + : errs:Format.formatter + -> subst:(string -> string option) + -> Buffer.t + -> string + -> string + +(** this is a comment + + @author foo + + @author Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @version foo + + @version Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @see <foo> foo + + @see <https://slash-create.js.org/#/docs/main/latest/class/SlashCreator?scrollTo=registerCommandsIn> this url is very long + + @since foo + + @since Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @before foo [foo] + + @before Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @deprecated [foo] + + @deprecated Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @param foo [foo] + + @param Foooooooooooooo_Baaaaaaaaaaaaar Fooooooooooo foooooooooooo fooooooooooo baaaaaaaaar + + @param Foooooooooooooooooooooooooooooooooooo_baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @raise foo [foo] + + @raise Foooooooooooooooooooooooooooooooooooo_baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @return [foo] + + @inline + + @canonical foo + + @canonical Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar *) +val k : k + +(** a comment + + @version foo *) +val x : x + +(** Managing Chunks. + + This module exposes functors to store raw contents into append-only + stores as chunks of same size. It exposes the {{!AO} AO} functor which + split the raw contents into [Data] blocks, addressed by [Node] blocks. + That's the usual rope-like representation of strings, but chunk trees + are always build as perfectly well-balanced and blocks are addressed by + their hash (or by the stable keys returned by the underlying store). + + A chunk has the following structure: + + {v + -------------------------- -------------------------- + | uint8_t type | | uint8_t type | + --------------------------- --------------------------- + | uint16_t | | uint64_t | + --------------------------- --------------------------- + | key children[length] | | byte data[length] | + --------------------------- --------------------------- + v} + + [type] is either [Data] (0) or [Index] (1). If the chunk contains data, + [length] is the payload length. Otherwise it is the number of children + that the node has. + + It also exposes {{!AO_stable} AO_stable} which -- as {{!AO} AO} does -- + stores raw contents into chunks of same size. But it also preserves the + nice properpty that values are addressed by their hash. instead of by + the hash of the root chunk node as it is the case for {{!AO} AO}. *) + +(** This is verbatim: + + {v + o o + /\ /\ + /\ /\ + v} + + This is preformated code: + + {[ +let verbatim s = + s |> String.split_lines |> List.map ~f:String.strip + |> fun s -> list s "@," Fmt.str + ]} *) + +(** Lists: + + list with short lines: + + - x + - y + - z + + list with long lines: + + - xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx + xxx xxx xxx xxx xxx xxx xxx + - yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy + yyy yyy yyy yyy yyy yyy yyy + - zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz + zzz zzz zzz zzz zzz zzz zzz + + enumerated list with long lines: + + + xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx + xxx xxx xxx xxx xxx xxx xxx + + yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy + yyy yyy yyy yyy yyy yyy yyy + + zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz + zzz zzz zzz zzz zzz zzz zzz + + list with sub lists: + + {ul + {- xxx + + - a + - b + - c + } + {- yyy + + + a + + b + + c + }} *) + +(** {{:https://github.com/} Github} *) + +(** {:https://github.com/} *) + +(** An array index offset: [exp1\[exp2\]] *) + +(** to extend \{foo syntax *) + +(** The different forms of references in \@see tags. *) + +(** Printf groff string for the \@before information. *) + +(** [a]'c [b]'s [c]'c *) + +(** return true if [\gamma(lhs) \subseteq \gamma(rhs)] *) + +(** Composition of functions: [(f >> g) x] is exactly equivalent to + [g (f (x))]. Left associative. *) + +(** [†] [Struct_rec] is *) + +(** for [Global]s *) + +(** generic command: ∀xs.[foot]-[post] *) + +(** A *) +val foo : int -> unit +(** B *) + +(** C *) + +(** A *) +val foo : int -> unit +(** B *) + +module Foo : sig + (** A *) + val foo : int -> unit + (** B *) + + (** C *) + + (** A *) + val foo : int -> unit + (** B *) +end + +(** [\[ \] \[\] \]] *) + +(** \{ \} \[ \] \@ \@ *) + +(** @canonical Foo *) + +(** @canonical Module.Foo.Bar *) + +(** {v +a + v} *) + +(** {[ +b + ]} *) + +(** - Odoc don't parse + + multiple paragraph in a list *) + +(** {ul + {- Abc + + Def + } + {- Hij + } + {- Klm + + {ul + {- Nop + + Qrs + } + {- Tuv + }} + }} *) + +(** - {v + Abc + def + v} + - {[ +A + B + ]} *) + +(** Code block + {[ Single line ]} + {[ + Multi + line + ]} + {[ + Multi + line + with + indentation + ]} + {[ Single long line HAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA ]} + {[ + With empty + + line + ]} + {[ First line + on the same line + as opening ]} + *) + +module X : sig + (** {[ First line + on the same line + as opening ]} *) +end + +(** {!module:A} {!module:A.B} + + {!module-type:A} {!module-type:A.b} + + {!class:c} {!class:M.c} + + {!class-type:c} {!class-type:M.c} + + {!val:x} {!val:M.x} + + {!type:t} {!type:M.t} + + {!exception:E} {!exception:M.E} + + {!method:m} {!method:c.m} + + {!constructor:C} {!constructor:M.C} + + {!field:f} {!field:t.f} {!field:M.t.f} + *) + +(** {!modules:Foo} + + {!modules:Foo Bar.Baz} + + @canonical Foo + + @canonical Foo.Bar +*) + +(** {%html:<p>Raw markup</p>%} {%Without language%} {%other:Other language%} *) + +(** [Multi + Line] + + [ A lot of spaces ] + + [Very looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong] *) + +(** {[ + for i = 1 to 3 + do + Printf.printf "let x%d = %d\n" i i + done +]} *) + +(** {[ + print_newline (); + List.iter + (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s) + ["+"; "-"; "*"; "/"] +]} *) + +(** {[ + #use "import.cinaps";; + + List.iter all_fields ~f:(fun (name, type_) -> printf "\nexternal get_%s + : unit -> %s = \"get_%s\"" name type_ name) +]} *) + +(** {[ + + + List.iter all_fields ~f:(fun (name, type_) -> printf "\nexternal get_%s + : unit -> %s = \"get_%s\"" name type_ name) +]} *) + +(** {[ + let x = 1 in + + (* fooooooo *) + let y = 2 in + (* foooooooo *) + z +]} *) + +(** {[ + let this = is_short +]} + +{[ + does not parse: verbatim ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+ +]} + +{[ +[@@@ocamlformat "break-separators = after"] + +let fooooooooooooooooo = +[ foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo ] + +]} + +{[ +let fooooooooooooooooo = +[ foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo ] + +]} *) + +(** + This is a comment with code inside + {[ + (** This is a comment with code inside + [ let code inside = f inside ] + *) + let code inside (* comment *) = f inside + ]} + + Code block with metadata: + {@ocaml[ code ]} + + {@ocaml kind=toplevel[ code ]} + + {@ocaml kind=toplevel env=e1[ + (** This is a comment with code inside + [ let code inside = f inside ] + *) + let code inside (* comment *) = f inside + ]} +*) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo} {i fooooooooooooo oooooooo oooooooooo} {b fooooooooooooo oooooooooooo oooooo ooooooo} *) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo} {{!some ref} fooooooooooooo + oooooooo oooooooooo} {b fooooooooooooo oooooooooooo oooooo ooooooo} *) + +(** foooooooooooooooooooooooooooooooooooooooooooooooooo foooooooooooo {b eee + eee eee} *) + +(** foooooooooooooooooooooooooooooooooooooooooooooooooo foooooooooooooooo {b + eee + eee eee} *) + +val f : int + +(***) + +val k : int + +(**) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}}} *) + +(** {e + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}} foooooooo + oooooooooo ooooooooo ooooooooo} *) + +(** foooooooooo fooooooooooo + + {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}} fooooooooooooo + foooooooooo fooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}}} + + {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo}} + + fooooooooooooo foooooooooooooo: + + - foo + - {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo}} + - {e foooooooo oooooooooo ooooooooo ooooooooo} + {i fooooooooooooo oooooooo oooooooooo} + - foo *) + +(** Brackets must not be escaped in the first argument of some tags: *) + +(** @raise [Invalid_argument] if the argument is [None]. Sometimes [t.[x]]. *) + +(** @author [Abc] [def] \[hij\] *) + +(** @author {Abc} {def} \{hij\} *) + +(** @param [id] [def] \[hij\] *) + +(** @raise [exn] [def] \[hij\] *) + +(** @since [Abc] [def] \[hij\] *) + +(** @before [Abc] [def] \[hij\] *) + +(** @version [Abc] [def] \[hij\] *) + +(** @see <[Abc]> [def] \[hij\] *) + +(** @see '[Abc]' [def] \[hij\] *) + +(** @see "[Abc]" [def] \[hij\] *) + +(** \[abc\] *) + +(** *) + +(** *) + +(** [trim " "] is [""] *) + +(** [trms (c × (Σᵢ₌₁ⁿ cᵢ × Πⱼ₌₁ᵐᵢ Xᵢⱼ^pᵢⱼ))] + is the sequence of terms [Xᵢⱼ] for each [i] and [j]. *) + +(** + +Lorem ipsum dolor sit amet, consectetur adipiscing elit. Morbi lacinia odio sit amet lobortis fringilla. Mauris diam massa, vulputate sit amet lacus id, vestibulum bibendum lectus. Nullam tristique justo nisi, gravida dapibus mi pulvinar at. Suspendisse pellentesque odio quis ipsum tempor luctus. + +Cras ultrices, magna sit amet faucibus molestie, sapien dolor ullamcorper lorem, vel viverra tortor augue vel massa. Suspendisse nunc nisi, consequat et ante nec, efficitur dapibus ipsum. Aenean vitae pellentesque odio. Integer et ornare tellus, at tristique elit. + +Phasellus et nisi id neque ultrices vestibulum vitae non tortor. Mauris aliquet at risus sed rhoncus. Ut condimentum rhoncus orci, sit amet eleifend erat tempus quis. + +*) + +(** {[(* a + b *)]} *) + +val a + : fooooooooooooooooooooooooooo (** {[(* a + b *)]} *) + -> fooooooooooooooooooooooooo + +type x = + { a : t (** {[(* a + b *)]} *) + ; b : [ `A (** {[(* a + b *)]} *) ] + } + +type x = + | A of a (** {[(* a + b *)]} *) + | B of b (** {[(* a + b *)]} *) + +(** Set a different language name in the block metadata to not format as OCaml: + + {@sh[ echo "this""is""only""a""single"(echo word)(echo also) ]} *) + +(**a*) + +(**b*) + +(** Inline math: {m \infty} + + Inline math elements can wrap as well {m \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty} or {m \f\relax{x} = \int_{-\infty}^\infty \f\hat\xi\,e^{2 \pi i \xi x} \,d\xi}. + + Block math: + + {math \infty} + + {math + \infty + } + + {math + + \pi + + } + + {math + + \infty + + \pi + + \pi + + \pi + + } + + {math {m \f\relax{x} = \int_{-\infty}^\infty \f\hat\xi\,e^{2 \pi i \xi x} \,d\xi}} + + {math + % \f is defined as #1f(#2) using the macro + \f\relax{x} = \int_{-\infty}^\infty + \f\hat\xi\,e^{2 \pi i \xi x} + \,d\xi + } +*) + +(** {[ + let _ = {| + Doc-comment contains code blocks that contains string with breaks and + ending with trailing spaces. + |} + ]} *) + +(** ISO-Latin1 characters in identifiers + {[ω]}*) + +(** Here, [my_list=[]]. *) + +(** Here, [my_list=\[\]]. *) + +(** This code block will change due to the brackets being re-escaped. + [ [ \[ [] ] ]. *) + +(** at@ *) + +(** \@at *) + +(** Lists can't be nested + - foo + - module system documentation including + {ol + {- bar} + {- baz} + } +*) + +(** Space before a reference or link text is preserved. A newline is turned + into a space. {{!ref} + with newline} and {{!ref} with space}. *) diff --git a/test/passing/refs.janestreet/doc_comments-no-wrap.mli.err b/test/passing/refs.janestreet/doc_comments-no-wrap.mli.err new file mode 100644 index 0000000000..728825b61b --- /dev/null +++ b/test/passing/refs.janestreet/doc_comments-no-wrap.mli.err @@ -0,0 +1,13 @@ +Warning: doc_comments-no-wrap.mli:92 exceeds the margin +Warning: doc_comments-no-wrap.mli:100 exceeds the margin +Warning: doc_comments-no-wrap.mli:104 exceeds the margin +Warning: doc_comments-no-wrap.mli:108 exceeds the margin +Warning: doc_comments-no-wrap.mli:110 exceeds the margin +Warning: doc_comments-no-wrap.mli:114 exceeds the margin +Warning: doc_comments-no-wrap.mli:122 exceeds the margin +Warning: doc_comments-no-wrap.mli:469 exceeds the margin +Warning: doc_comments-no-wrap.mli:476 exceeds the margin +Warning: doc_comments-no-wrap.mli:553 exceeds the margin +Warning: doc_comments-no-wrap.mli:555 exceeds the margin +Warning: doc_comments-no-wrap.mli:557 exceeds the margin +Warning: doc_comments-no-wrap.mli:592 exceeds the margin diff --git a/test/passing/refs.janestreet/doc_comments-no-wrap.mli.ref b/test/passing/refs.janestreet/doc_comments-no-wrap.mli.ref new file mode 100644 index 0000000000..7a2e24644f --- /dev/null +++ b/test/passing/refs.janestreet/doc_comments-no-wrap.mli.ref @@ -0,0 +1,663 @@ +(** Manpages. See {!Cmdliner.Manpage}. *) + +type block = + [ `S of string + | `P of string + | `Pre of string + | `I of string * string + | `Noblank + | `Blocks of block list + ] + +(** Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod *) +include M with type t := t + +(** [escape s] escapes [s] from the doc language. *) +val escape : string -> string + +type title = string * int * string * string * string + +(** {1:standard-section-names Standard section names} *) + +val s_name : string + +(** {1:section-maps Section maps} + + Used for handling the merging of metadata doc strings. *) + +type smap + +(** [smap_append_block smap sec b] appends [b] at the end of section [sec] + creating it at the right place if needed. *) +val smap_append_block : smap -> sec:string -> block -> smap + +(** {1:content-boilerplate Content boilerplate} *) + +val s_environment_intro : block + +(** {1:output Output} *) + +type format = + [ `Auto + | `Pager + | `Plain + | `Groff + ] + +val print + : ?errs:Format.formatter + -> ?subst:(string -> string option) + -> format + -> Format.formatter + -> t + -> unit + +(** {1:printers-and-escapes-used-by-cmdliner-module Printers and escapes + used by Cmdliner module} *) + +(** [subst b ~subst s], using [b], substitutes in [s] variables of the form + "$(doc)" by their [subst] definition. This leaves escapes and markup + directives $(markup,...) intact. + + @raise Invalid_argument in case of illegal syntax. *) +val subst_vars + : errs:Format.formatter + -> subst:(string -> string option) + -> Buffer.t + -> string + -> string + +(** [doc_to_plain b ~subst s] using [b], subsitutes in [s] variables by + their [subst] definition and renders cmdliner directives to plain text. + + @raise Invalid_argument in case of illegal syntax. *) +val doc_to_plain + : errs:Format.formatter + -> subst:(string -> string option) + -> Buffer.t + -> string + -> string + +(** this is a comment + + @author foo + + @author Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @version foo + + @version Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @see <foo> foo + + @see <https://slash-create.js.org/#/docs/main/latest/class/SlashCreator?scrollTo=registerCommandsIn> this url is very long + + @since foo + + @since Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @before foo [foo] + + @before Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @deprecated [foo] + + @deprecated Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @param foo [foo] + + @param Foooooooooooooo_Baaaaaaaaaaaaar Fooooooooooo foooooooooooo fooooooooooo baaaaaaaaar + + @param Foooooooooooooooooooooooooooooooooooo_baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @raise foo [foo] + + @raise Foooooooooooooooooooooooooooooooooooo_baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @return [foo] + + @inline + + @canonical foo + + @canonical Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar *) +val k : k + +(** a comment + + @version foo *) +val x : x + +(** Managing Chunks. + + This module exposes functors to store raw contents into append-only + stores as chunks of same size. It exposes the {{!AO} AO} functor which + split the raw contents into [Data] blocks, addressed by [Node] blocks. + That's the usual rope-like representation of strings, but chunk trees + are always build as perfectly well-balanced and blocks are addressed by + their hash (or by the stable keys returned by the underlying store). + + A chunk has the following structure: + + {v + -------------------------- -------------------------- + | uint8_t type | | uint8_t type | + --------------------------- --------------------------- + | uint16_t | | uint64_t | + --------------------------- --------------------------- + | key children[length] | | byte data[length] | + --------------------------- --------------------------- + v} + + [type] is either [Data] (0) or [Index] (1). If the chunk contains data, + [length] is the payload length. Otherwise it is the number of children + that the node has. + + It also exposes {{!AO_stable} AO_stable} which -- as {{!AO} AO} does -- + stores raw contents into chunks of same size. But it also preserves the + nice properpty that values are addressed by their hash. instead of by + the hash of the root chunk node as it is the case for {{!AO} AO}. *) + +(** This is verbatim: + + {v + o o + /\ /\ + /\ /\ + v} + + This is preformated code: + + {[ +let verbatim s = + s |> String.split_lines |> List.map ~f:String.strip + |> fun s -> list s "@," Fmt.str + ]} *) + +(** Lists: + + list with short lines: + + - x + - y + - z + + list with long lines: + + - xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx + xxx xxx xxx xxx xxx xxx xxx + - yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy + yyy yyy yyy yyy yyy yyy yyy + - zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz + zzz zzz zzz zzz zzz zzz zzz + + enumerated list with long lines: + + + xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx + xxx xxx xxx xxx xxx xxx xxx + + yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy + yyy yyy yyy yyy yyy yyy yyy + + zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz + zzz zzz zzz zzz zzz zzz zzz + + list with sub lists: + + {ul + {- xxx + + - a + - b + - c + } + {- yyy + + + a + + b + + c + }} *) + +(** {{:https://github.com/} Github} *) + +(** {:https://github.com/} *) + +(** An array index offset: [exp1\[exp2\]] *) + +(** to extend \{foo syntax *) + +(** The different forms of references in \@see tags. *) + +(** Printf groff string for the \@before information. *) + +(** [a]'c [b]'s [c]'c *) + +(** return true if [\gamma(lhs) \subseteq \gamma(rhs)] *) + +(** Composition of functions: [(f >> g) x] is exactly equivalent to + [g (f (x))]. Left associative. *) + +(** [†] [Struct_rec] is *) + +(** for [Global]s *) + +(** generic command: ∀xs.[foot]-[post] *) + +(** A *) +val foo : int -> unit +(** B *) + +(** C *) + +(** A *) +val foo : int -> unit +(** B *) + +module Foo : sig + (** A *) + val foo : int -> unit + (** B *) + + (** C *) + + (** A *) + val foo : int -> unit + (** B *) +end + +(** [\[ \] \[\] \]] *) + +(** \{ \} \[ \] \@ \@ *) + +(** @canonical Foo *) + +(** @canonical Module.Foo.Bar *) + +(** {v +a + v} *) + +(** {[ +b + ]} *) + +(** - Odoc don't parse + + multiple paragraph in a list *) + +(** {ul + {- Abc + + Def + } + {- Hij + } + {- Klm + + {ul + {- Nop + + Qrs + } + {- Tuv + }} + }} *) + +(** - {v + Abc + def + v} + - {[ +A + B + ]} *) + +(** Code block + {[ Single line ]} + {[ + Multi + line + ]} + {[ + Multi + line + with + indentation + ]} + {[ Single long line HAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA ]} + {[ + With empty + + line + ]} + {[ First line + on the same line + as opening ]} + *) + +module X : sig + (** {[ First line + on the same line + as opening ]} *) +end + +(** {!module:A} {!module:A.B} + + {!module-type:A} {!module-type:A.b} + + {!class:c} {!class:M.c} + + {!class-type:c} {!class-type:M.c} + + {!val:x} {!val:M.x} + + {!type:t} {!type:M.t} + + {!exception:E} {!exception:M.E} + + {!method:m} {!method:c.m} + + {!constructor:C} {!constructor:M.C} + + {!field:f} {!field:t.f} {!field:M.t.f} + *) + +(** {!modules:Foo} + + {!modules:Foo Bar.Baz} + + @canonical Foo + + @canonical Foo.Bar +*) + +(** {%html:<p>Raw markup</p>%} {%Without language%} {%other:Other language%} *) + +(** [Multi + Line] + + [ A lot of spaces ] + + [Very looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong] *) + +(** {[ + for i = 1 to 3 + do + Printf.printf "let x%d = %d\n" i i + done +]} *) + +(** {[ + print_newline (); + List.iter + (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s) + ["+"; "-"; "*"; "/"] +]} *) + +(** {[ + #use "import.cinaps";; + + List.iter all_fields ~f:(fun (name, type_) -> printf "\nexternal get_%s + : unit -> %s = \"get_%s\"" name type_ name) +]} *) + +(** {[ + + + List.iter all_fields ~f:(fun (name, type_) -> printf "\nexternal get_%s + : unit -> %s = \"get_%s\"" name type_ name) +]} *) + +(** {[ + let x = 1 in + + (* fooooooo *) + let y = 2 in + (* foooooooo *) + z +]} *) + +(** {[ + let this = is_short +]} + +{[ + does not parse: verbatim ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+ +]} + +{[ +[@@@ocamlformat "break-separators = after"] + +let fooooooooooooooooo = +[ foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo ] + +]} + +{[ +let fooooooooooooooooo = +[ foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo ] + +]} *) + +(** + This is a comment with code inside + {[ + (** This is a comment with code inside + [ let code inside = f inside ] + *) + let code inside (* comment *) = f inside + ]} + + Code block with metadata: + {@ocaml[ code ]} + + {@ocaml kind=toplevel[ code ]} + + {@ocaml kind=toplevel env=e1[ + (** This is a comment with code inside + [ let code inside = f inside ] + *) + let code inside (* comment *) = f inside + ]} +*) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo} {i fooooooooooooo oooooooo oooooooooo} {b fooooooooooooo oooooooooooo oooooo ooooooo} *) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo} {{!some ref} fooooooooooooo + oooooooo oooooooooo} {b fooooooooooooo oooooooooooo oooooo ooooooo} *) + +(** foooooooooooooooooooooooooooooooooooooooooooooooooo foooooooooooo {b eee + eee eee} *) + +(** foooooooooooooooooooooooooooooooooooooooooooooooooo foooooooooooooooo {b + eee + eee eee} *) + +val f : int + +(***) + +val k : int + +(**) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}}} *) + +(** {e + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}} foooooooo + oooooooooo ooooooooo ooooooooo} *) + +(** foooooooooo fooooooooooo + + {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}} fooooooooooooo + foooooooooo fooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}}} + + {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo}} + + fooooooooooooo foooooooooooooo: + + - foo + - {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo}} + - {e foooooooo oooooooooo ooooooooo ooooooooo} + {i fooooooooooooo oooooooo oooooooooo} + - foo *) + +(** Brackets must not be escaped in the first argument of some tags: *) + +(** @raise [Invalid_argument] if the argument is [None]. Sometimes [t.[x]]. *) + +(** @author [Abc] [def] \[hij\] *) + +(** @author {Abc} {def} \{hij\} *) + +(** @param [id] [def] \[hij\] *) + +(** @raise [exn] [def] \[hij\] *) + +(** @since [Abc] [def] \[hij\] *) + +(** @before [Abc] [def] \[hij\] *) + +(** @version [Abc] [def] \[hij\] *) + +(** @see <[Abc]> [def] \[hij\] *) + +(** @see '[Abc]' [def] \[hij\] *) + +(** @see "[Abc]" [def] \[hij\] *) + +(** \[abc\] *) + +(** *) + +(** *) + +(** [trim " "] is [""] *) + +(** [trms (c × (Σᵢ₌₁ⁿ cᵢ × Πⱼ₌₁ᵐᵢ Xᵢⱼ^pᵢⱼ))] + is the sequence of terms [Xᵢⱼ] for each [i] and [j]. *) + +(** + +Lorem ipsum dolor sit amet, consectetur adipiscing elit. Morbi lacinia odio sit amet lobortis fringilla. Mauris diam massa, vulputate sit amet lacus id, vestibulum bibendum lectus. Nullam tristique justo nisi, gravida dapibus mi pulvinar at. Suspendisse pellentesque odio quis ipsum tempor luctus. + +Cras ultrices, magna sit amet faucibus molestie, sapien dolor ullamcorper lorem, vel viverra tortor augue vel massa. Suspendisse nunc nisi, consequat et ante nec, efficitur dapibus ipsum. Aenean vitae pellentesque odio. Integer et ornare tellus, at tristique elit. + +Phasellus et nisi id neque ultrices vestibulum vitae non tortor. Mauris aliquet at risus sed rhoncus. Ut condimentum rhoncus orci, sit amet eleifend erat tempus quis. + +*) + +(** {[(* a + b *)]} *) + +val a + : fooooooooooooooooooooooooooo (** {[(* a + b *)]} *) + -> fooooooooooooooooooooooooo + +type x = + { a : t (** {[(* a + b *)]} *) + ; b : [ `A (** {[(* a + b *)]} *) ] + } + +type x = + | A of a (** {[(* a + b *)]} *) + | B of b (** {[(* a + b *)]} *) + +(** Set a different language name in the block metadata to not format as OCaml: + + {@sh[ echo "this""is""only""a""single"(echo word)(echo also) ]} *) + +(**a*) + +(**b*) + +(** Inline math: {m \infty} + + Inline math elements can wrap as well {m \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty} or {m \f\relax{x} = \int_{-\infty}^\infty \f\hat\xi\,e^{2 \pi i \xi x} \,d\xi}. + + Block math: + + {math \infty} + + {math + \infty + } + + {math + + \pi + + } + + {math + + \infty + + \pi + + \pi + + \pi + + } + + {math {m \f\relax{x} = \int_{-\infty}^\infty \f\hat\xi\,e^{2 \pi i \xi x} \,d\xi}} + + {math + % \f is defined as #1f(#2) using the macro + \f\relax{x} = \int_{-\infty}^\infty + \f\hat\xi\,e^{2 \pi i \xi x} + \,d\xi + } +*) + +(** {[ + let _ = {| + Doc-comment contains code blocks that contains string with breaks and + ending with trailing spaces. + |} + ]} *) + +(** ISO-Latin1 characters in identifiers + {[ω]}*) + +(** Here, [my_list=[]]. *) + +(** Here, [my_list=\[\]]. *) + +(** This code block will change due to the brackets being re-escaped. + [ [ \[ [] ] ]. *) + +(** at@ *) + +(** \@at *) + +(** Lists can't be nested + - foo + - module system documentation including + {ol + {- bar} + {- baz} + } +*) + +(** Space before a reference or link text is preserved. A newline is turned + into a space. {{!ref} + with newline} and {{!ref} with space}. *) diff --git a/test/passing/refs.janestreet/doc_comments.ml.err b/test/passing/refs.janestreet/doc_comments.ml.err new file mode 100644 index 0000000000..dd89f60d8e --- /dev/null +++ b/test/passing/refs.janestreet/doc_comments.ml.err @@ -0,0 +1,4 @@ +Warning: doc_comments.ml:258 exceeds the margin +Warning: doc_comments.ml:259 exceeds the margin +Warning: doc_comments.ml:260 exceeds the margin +Warning: doc_comments.ml:289 exceeds the margin diff --git a/test/passing/refs.janestreet/doc_comments.ml.ref b/test/passing/refs.janestreet/doc_comments.ml.ref new file mode 100644 index 0000000000..adf423ce45 --- /dev/null +++ b/test/passing/refs.janestreet/doc_comments.ml.ref @@ -0,0 +1,308 @@ +(** test *) +module A = B + +include A (** @open *) + +include B (** @open *) + +include A + +type t = C of int (** docstring comment *) +type t = C of int [@ocaml.doc " docstring attribute "] + +(** comment *) +include Mod + +(** before *) +let x = 2 +(** after *) + +(**floatting1*) +(**floatting2*) + +(**before*) +and y = 2 +(** after *) + +(** A *) +let a = 0 +(** A' *) + +module Comment_placement : sig + (** Type *) + type t + + (** Variant declaration *) + type t = T + + (** Type extension *) + type t += T + + (** Module *) + module A : B + + (** Module *) + module A : sig + type a + type b + end + + (** Val *) + val a : b + + (** Exception *) + exception E + + (** Include *) + include M + + (** Include *) + include sig + type a + type b + end + + (** Open *) + open M + + (** External *) + external a : b = "c" + + (** Rec module *) + module rec A : B + + (** Rec module *) + module rec A : sig + type a + type b + end + + (** Module type *) + module type A + + (** Module type *) + module type A = sig + type a + type b + end + + (** Class *) + class a : b + + (** Class type *) + class type a = b + + (* [@@@some attribute] *) + (* (** Attribute *) *) + + (** Extension *) + [%%some extension] + + (** A *) + external a : b = "double_comment" + (** B *) + + (** This comment goes before *) + module S_ext : sig + type t + end + + (** This one goes after *) + module Index : Index.S + + (** This one _still_ goes after *) + module Index2 + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end + + (** Doc comment still goes after *) + module Make (Config : sig + val blah : string + + (* this could be a really long signature *) + end) : S + + (** Generative functor *) + module Gen () : S +end = struct + (** Type *) + type t = { a : int } + + (** Variant declaration *) + type t = T + + (** Type extension *) + type t += T + + (** Module *) + module A = B + + (** Module *) + module A = struct + type a = A + type b = B + end + + (** Module *) + module A : sig + type a + type b + end = + B + + (** Let *) + let a = b + + (** Exception *) + exception E + + (** Include *) + include M + + (** Include *) + include struct + type a = A + type b = B + end + + (** Open *) + open M + + (** External *) + external a : b = "c" + + (** Rec module *) + module rec A : B = C + + (** Rec module *) + module rec A : B = struct + type a = A + type b = B + end + + (** Module type *) + module type A = B + + (** Module type *) + module type A = sig + type a + type b + end + + (** Class *) + class a = b + + (** Class *) + class b = + object + (** Method *) + method f = 0 + + (** Inherit *) + inherit a + + (** Val *) + val x = 1 + + (** Constraint *) + constraint 'a = [> ] + + (** Initialiser *) + initializer do_init () + end + + (** Class type *) + class type a = b + + (* [@@@some attribute] *) + (* (** Attribute *) *) + + (** Extension *) + [%%some extension] + + (* ;; *) + (* (** Eval *) *) + (* 1 + 1 *) + (* ;; *) + + (** A *) + external a : b = "double_comment" + (** B *) +end + +(** A *) +exception A of int +(** C *) + +(** {1:lbl Heading} *) + +(** {2 heading without label} *) + +module A = struct + module B = struct + (** It does not try to saturate + (1a) A = B + C /\ B = D + E => A = C + D + E + Nor combine more than 2 equations + (1b) A = B + C /\ B = D + E /\ F = C + D + E => A = F + + xxxxxxxxxxxxxxxxxxxxxxxxxxxx + (2) A = B + C /\ B = D + E => A = C + D - E + *) + let a b = () + end +end + +(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident, +* we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before +* processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *) +let _ = () + +(** Tags without text *) + +(** @see <Abc> *) + +(** @before a *) + +(** @deprecated *) + +(** @param b *) + +(** @raise c *) + +(** @return *) + +(** @see 'file' *) + +(** @see "title" *) + +(** + +starts with linebreaks +*) +let a = 1 + +(** {@metadata[ Code block with metadata field ]} *) + +(** {@some_tag[ Code block with metadata field. This is a big block that should hopefully break ]} *) + +(** {@ocaml[ + let _ = + f + @@ + { aaa= aaa bbb ccc + ; bbb= aaa bbb ccc + ; ccc= aaa bbb ccc } + >>= fun () -> + let _ = x in + f @@ g @@ h @@ fun x -> y + ]} *) + +(**{v + + foo + +v}*) diff --git a/test/passing/refs.janestreet/doc_comments.mli.err b/test/passing/refs.janestreet/doc_comments.mli.err new file mode 100644 index 0000000000..6d7cfc1e55 --- /dev/null +++ b/test/passing/refs.janestreet/doc_comments.mli.err @@ -0,0 +1,13 @@ +Warning: doc_comments.mli:92 exceeds the margin +Warning: doc_comments.mli:100 exceeds the margin +Warning: doc_comments.mli:104 exceeds the margin +Warning: doc_comments.mli:108 exceeds the margin +Warning: doc_comments.mli:110 exceeds the margin +Warning: doc_comments.mli:114 exceeds the margin +Warning: doc_comments.mli:122 exceeds the margin +Warning: doc_comments.mli:469 exceeds the margin +Warning: doc_comments.mli:476 exceeds the margin +Warning: doc_comments.mli:553 exceeds the margin +Warning: doc_comments.mli:555 exceeds the margin +Warning: doc_comments.mli:557 exceeds the margin +Warning: doc_comments.mli:592 exceeds the margin diff --git a/test/passing/refs.janestreet/doc_comments.mli.ref b/test/passing/refs.janestreet/doc_comments.mli.ref new file mode 100644 index 0000000000..7a2e24644f --- /dev/null +++ b/test/passing/refs.janestreet/doc_comments.mli.ref @@ -0,0 +1,663 @@ +(** Manpages. See {!Cmdliner.Manpage}. *) + +type block = + [ `S of string + | `P of string + | `Pre of string + | `I of string * string + | `Noblank + | `Blocks of block list + ] + +(** Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod *) +include M with type t := t + +(** [escape s] escapes [s] from the doc language. *) +val escape : string -> string + +type title = string * int * string * string * string + +(** {1:standard-section-names Standard section names} *) + +val s_name : string + +(** {1:section-maps Section maps} + + Used for handling the merging of metadata doc strings. *) + +type smap + +(** [smap_append_block smap sec b] appends [b] at the end of section [sec] + creating it at the right place if needed. *) +val smap_append_block : smap -> sec:string -> block -> smap + +(** {1:content-boilerplate Content boilerplate} *) + +val s_environment_intro : block + +(** {1:output Output} *) + +type format = + [ `Auto + | `Pager + | `Plain + | `Groff + ] + +val print + : ?errs:Format.formatter + -> ?subst:(string -> string option) + -> format + -> Format.formatter + -> t + -> unit + +(** {1:printers-and-escapes-used-by-cmdliner-module Printers and escapes + used by Cmdliner module} *) + +(** [subst b ~subst s], using [b], substitutes in [s] variables of the form + "$(doc)" by their [subst] definition. This leaves escapes and markup + directives $(markup,...) intact. + + @raise Invalid_argument in case of illegal syntax. *) +val subst_vars + : errs:Format.formatter + -> subst:(string -> string option) + -> Buffer.t + -> string + -> string + +(** [doc_to_plain b ~subst s] using [b], subsitutes in [s] variables by + their [subst] definition and renders cmdliner directives to plain text. + + @raise Invalid_argument in case of illegal syntax. *) +val doc_to_plain + : errs:Format.formatter + -> subst:(string -> string option) + -> Buffer.t + -> string + -> string + +(** this is a comment + + @author foo + + @author Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @version foo + + @version Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @see <foo> foo + + @see <https://slash-create.js.org/#/docs/main/latest/class/SlashCreator?scrollTo=registerCommandsIn> this url is very long + + @since foo + + @since Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @before foo [foo] + + @before Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @deprecated [foo] + + @deprecated Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @param foo [foo] + + @param Foooooooooooooo_Baaaaaaaaaaaaar Fooooooooooo foooooooooooo fooooooooooo baaaaaaaaar + + @param Foooooooooooooooooooooooooooooooooooo_baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @raise foo [foo] + + @raise Foooooooooooooooooooooooooooooooooooo_baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @return [foo] + + @inline + + @canonical foo + + @canonical Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar *) +val k : k + +(** a comment + + @version foo *) +val x : x + +(** Managing Chunks. + + This module exposes functors to store raw contents into append-only + stores as chunks of same size. It exposes the {{!AO} AO} functor which + split the raw contents into [Data] blocks, addressed by [Node] blocks. + That's the usual rope-like representation of strings, but chunk trees + are always build as perfectly well-balanced and blocks are addressed by + their hash (or by the stable keys returned by the underlying store). + + A chunk has the following structure: + + {v + -------------------------- -------------------------- + | uint8_t type | | uint8_t type | + --------------------------- --------------------------- + | uint16_t | | uint64_t | + --------------------------- --------------------------- + | key children[length] | | byte data[length] | + --------------------------- --------------------------- + v} + + [type] is either [Data] (0) or [Index] (1). If the chunk contains data, + [length] is the payload length. Otherwise it is the number of children + that the node has. + + It also exposes {{!AO_stable} AO_stable} which -- as {{!AO} AO} does -- + stores raw contents into chunks of same size. But it also preserves the + nice properpty that values are addressed by their hash. instead of by + the hash of the root chunk node as it is the case for {{!AO} AO}. *) + +(** This is verbatim: + + {v + o o + /\ /\ + /\ /\ + v} + + This is preformated code: + + {[ +let verbatim s = + s |> String.split_lines |> List.map ~f:String.strip + |> fun s -> list s "@," Fmt.str + ]} *) + +(** Lists: + + list with short lines: + + - x + - y + - z + + list with long lines: + + - xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx + xxx xxx xxx xxx xxx xxx xxx + - yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy + yyy yyy yyy yyy yyy yyy yyy + - zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz + zzz zzz zzz zzz zzz zzz zzz + + enumerated list with long lines: + + + xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx + xxx xxx xxx xxx xxx xxx xxx + + yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy + yyy yyy yyy yyy yyy yyy yyy + + zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz + zzz zzz zzz zzz zzz zzz zzz + + list with sub lists: + + {ul + {- xxx + + - a + - b + - c + } + {- yyy + + + a + + b + + c + }} *) + +(** {{:https://github.com/} Github} *) + +(** {:https://github.com/} *) + +(** An array index offset: [exp1\[exp2\]] *) + +(** to extend \{foo syntax *) + +(** The different forms of references in \@see tags. *) + +(** Printf groff string for the \@before information. *) + +(** [a]'c [b]'s [c]'c *) + +(** return true if [\gamma(lhs) \subseteq \gamma(rhs)] *) + +(** Composition of functions: [(f >> g) x] is exactly equivalent to + [g (f (x))]. Left associative. *) + +(** [†] [Struct_rec] is *) + +(** for [Global]s *) + +(** generic command: ∀xs.[foot]-[post] *) + +(** A *) +val foo : int -> unit +(** B *) + +(** C *) + +(** A *) +val foo : int -> unit +(** B *) + +module Foo : sig + (** A *) + val foo : int -> unit + (** B *) + + (** C *) + + (** A *) + val foo : int -> unit + (** B *) +end + +(** [\[ \] \[\] \]] *) + +(** \{ \} \[ \] \@ \@ *) + +(** @canonical Foo *) + +(** @canonical Module.Foo.Bar *) + +(** {v +a + v} *) + +(** {[ +b + ]} *) + +(** - Odoc don't parse + + multiple paragraph in a list *) + +(** {ul + {- Abc + + Def + } + {- Hij + } + {- Klm + + {ul + {- Nop + + Qrs + } + {- Tuv + }} + }} *) + +(** - {v + Abc + def + v} + - {[ +A + B + ]} *) + +(** Code block + {[ Single line ]} + {[ + Multi + line + ]} + {[ + Multi + line + with + indentation + ]} + {[ Single long line HAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA ]} + {[ + With empty + + line + ]} + {[ First line + on the same line + as opening ]} + *) + +module X : sig + (** {[ First line + on the same line + as opening ]} *) +end + +(** {!module:A} {!module:A.B} + + {!module-type:A} {!module-type:A.b} + + {!class:c} {!class:M.c} + + {!class-type:c} {!class-type:M.c} + + {!val:x} {!val:M.x} + + {!type:t} {!type:M.t} + + {!exception:E} {!exception:M.E} + + {!method:m} {!method:c.m} + + {!constructor:C} {!constructor:M.C} + + {!field:f} {!field:t.f} {!field:M.t.f} + *) + +(** {!modules:Foo} + + {!modules:Foo Bar.Baz} + + @canonical Foo + + @canonical Foo.Bar +*) + +(** {%html:<p>Raw markup</p>%} {%Without language%} {%other:Other language%} *) + +(** [Multi + Line] + + [ A lot of spaces ] + + [Very looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong] *) + +(** {[ + for i = 1 to 3 + do + Printf.printf "let x%d = %d\n" i i + done +]} *) + +(** {[ + print_newline (); + List.iter + (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s) + ["+"; "-"; "*"; "/"] +]} *) + +(** {[ + #use "import.cinaps";; + + List.iter all_fields ~f:(fun (name, type_) -> printf "\nexternal get_%s + : unit -> %s = \"get_%s\"" name type_ name) +]} *) + +(** {[ + + + List.iter all_fields ~f:(fun (name, type_) -> printf "\nexternal get_%s + : unit -> %s = \"get_%s\"" name type_ name) +]} *) + +(** {[ + let x = 1 in + + (* fooooooo *) + let y = 2 in + (* foooooooo *) + z +]} *) + +(** {[ + let this = is_short +]} + +{[ + does not parse: verbatim ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+ +]} + +{[ +[@@@ocamlformat "break-separators = after"] + +let fooooooooooooooooo = +[ foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo ] + +]} + +{[ +let fooooooooooooooooo = +[ foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo ] + +]} *) + +(** + This is a comment with code inside + {[ + (** This is a comment with code inside + [ let code inside = f inside ] + *) + let code inside (* comment *) = f inside + ]} + + Code block with metadata: + {@ocaml[ code ]} + + {@ocaml kind=toplevel[ code ]} + + {@ocaml kind=toplevel env=e1[ + (** This is a comment with code inside + [ let code inside = f inside ] + *) + let code inside (* comment *) = f inside + ]} +*) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo} {i fooooooooooooo oooooooo oooooooooo} {b fooooooooooooo oooooooooooo oooooo ooooooo} *) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo} {{!some ref} fooooooooooooo + oooooooo oooooooooo} {b fooooooooooooo oooooooooooo oooooo ooooooo} *) + +(** foooooooooooooooooooooooooooooooooooooooooooooooooo foooooooooooo {b eee + eee eee} *) + +(** foooooooooooooooooooooooooooooooooooooooooooooooooo foooooooooooooooo {b + eee + eee eee} *) + +val f : int + +(***) + +val k : int + +(**) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}}} *) + +(** {e + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}} foooooooo + oooooooooo ooooooooo ooooooooo} *) + +(** foooooooooo fooooooooooo + + {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}} fooooooooooooo + foooooooooo fooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}}} + + {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo}} + + fooooooooooooo foooooooooooooo: + + - foo + - {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo}} + - {e foooooooo oooooooooo ooooooooo ooooooooo} + {i fooooooooooooo oooooooo oooooooooo} + - foo *) + +(** Brackets must not be escaped in the first argument of some tags: *) + +(** @raise [Invalid_argument] if the argument is [None]. Sometimes [t.[x]]. *) + +(** @author [Abc] [def] \[hij\] *) + +(** @author {Abc} {def} \{hij\} *) + +(** @param [id] [def] \[hij\] *) + +(** @raise [exn] [def] \[hij\] *) + +(** @since [Abc] [def] \[hij\] *) + +(** @before [Abc] [def] \[hij\] *) + +(** @version [Abc] [def] \[hij\] *) + +(** @see <[Abc]> [def] \[hij\] *) + +(** @see '[Abc]' [def] \[hij\] *) + +(** @see "[Abc]" [def] \[hij\] *) + +(** \[abc\] *) + +(** *) + +(** *) + +(** [trim " "] is [""] *) + +(** [trms (c × (Σᵢ₌₁ⁿ cᵢ × Πⱼ₌₁ᵐᵢ Xᵢⱼ^pᵢⱼ))] + is the sequence of terms [Xᵢⱼ] for each [i] and [j]. *) + +(** + +Lorem ipsum dolor sit amet, consectetur adipiscing elit. Morbi lacinia odio sit amet lobortis fringilla. Mauris diam massa, vulputate sit amet lacus id, vestibulum bibendum lectus. Nullam tristique justo nisi, gravida dapibus mi pulvinar at. Suspendisse pellentesque odio quis ipsum tempor luctus. + +Cras ultrices, magna sit amet faucibus molestie, sapien dolor ullamcorper lorem, vel viverra tortor augue vel massa. Suspendisse nunc nisi, consequat et ante nec, efficitur dapibus ipsum. Aenean vitae pellentesque odio. Integer et ornare tellus, at tristique elit. + +Phasellus et nisi id neque ultrices vestibulum vitae non tortor. Mauris aliquet at risus sed rhoncus. Ut condimentum rhoncus orci, sit amet eleifend erat tempus quis. + +*) + +(** {[(* a + b *)]} *) + +val a + : fooooooooooooooooooooooooooo (** {[(* a + b *)]} *) + -> fooooooooooooooooooooooooo + +type x = + { a : t (** {[(* a + b *)]} *) + ; b : [ `A (** {[(* a + b *)]} *) ] + } + +type x = + | A of a (** {[(* a + b *)]} *) + | B of b (** {[(* a + b *)]} *) + +(** Set a different language name in the block metadata to not format as OCaml: + + {@sh[ echo "this""is""only""a""single"(echo word)(echo also) ]} *) + +(**a*) + +(**b*) + +(** Inline math: {m \infty} + + Inline math elements can wrap as well {m \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty} or {m \f\relax{x} = \int_{-\infty}^\infty \f\hat\xi\,e^{2 \pi i \xi x} \,d\xi}. + + Block math: + + {math \infty} + + {math + \infty + } + + {math + + \pi + + } + + {math + + \infty + + \pi + + \pi + + \pi + + } + + {math {m \f\relax{x} = \int_{-\infty}^\infty \f\hat\xi\,e^{2 \pi i \xi x} \,d\xi}} + + {math + % \f is defined as #1f(#2) using the macro + \f\relax{x} = \int_{-\infty}^\infty + \f\hat\xi\,e^{2 \pi i \xi x} + \,d\xi + } +*) + +(** {[ + let _ = {| + Doc-comment contains code blocks that contains string with breaks and + ending with trailing spaces. + |} + ]} *) + +(** ISO-Latin1 characters in identifiers + {[ω]}*) + +(** Here, [my_list=[]]. *) + +(** Here, [my_list=\[\]]. *) + +(** This code block will change due to the brackets being re-escaped. + [ [ \[ [] ] ]. *) + +(** at@ *) + +(** \@at *) + +(** Lists can't be nested + - foo + - module system documentation including + {ol + {- bar} + {- baz} + } +*) + +(** Space before a reference or link text is preserved. A newline is turned + into a space. {{!ref} + with newline} and {{!ref} with space}. *) diff --git a/test/passing/refs.janestreet/doc_comments_padding.ml.ref b/test/passing/refs.janestreet/doc_comments_padding.ml.ref new file mode 100644 index 0000000000..3d1f85317c --- /dev/null +++ b/test/passing/refs.janestreet/doc_comments_padding.ml.ref @@ -0,0 +1,37 @@ +type t = + { a : int (** a *) + ; b : int (** b *) + } + +type t = < a : int (** a *) ; b : int (** b *) > + +type t = + [ `a of int (** a *) + | `b of int (** b *) + ] + +type t = + | A of int (** a *) + | B of int (** b *) + +type t += A of int (** a *) | B of int (** b *) + +[@@@ocamlformat "doc-comments-padding=1"] + +type t = + { a : int (** a *) + ; b : int (** b *) + } + +type t = < a : int (** a *) ; b : int (** b *) > + +type t = + [ `a of int (** a *) + | `b of int (** b *) + ] + +type t = + | A of int (** a *) + | B of int (** b *) + +type t += A of int (** a *) | B of int (** b *) diff --git a/test/passing/refs.janestreet/doc_repl.mld.ref b/test/passing/refs.janestreet/doc_repl.mld.ref new file mode 100644 index 0000000000..a5810ba945 --- /dev/null +++ b/test/passing/refs.janestreet/doc_repl.mld.ref @@ -0,0 +1,92 @@ +Block delimiters should be on their own line: + +{[ + let x = 1 +]} + +As of odoc 2.1, a block can carry metadata: + +{@ocaml[ + let x = 2 +]} + +An OCaml block that should break: + +{[ + let x = 2 in + x + x +]} + +A toplevel phrase with no output: + +{[ + # let x = 2 + and y = 3 in + x + y + ;; +]} + +A toplevel phrase with output: + +{[ + # let x = 2;; + val x : int = 2 +]} + +Many toplevel phrases without output: + +{[ + # let x = 2;; + # x + 2;; + # let x = 2 + and y = 3 in + x + y + ;; +]} + +Many toplevel phrases with output: + +{[ + # let x = 2;; + val x : int = 2 + # x + 2;; + - : int = 4 + # let x = 2 + and y = 3 in + x + y + ;; +]} + +Output are printed after a newline: + +{[ + # let x = 2;; val x : int = 2 + # let x = 3;; + # let x = 4;; val x : int = 4 +]} + +Excessive linebreaks are removed: + +{[ + # let x = 2 in + x + 1 + ;; + output + # let y = 3 in + y + 1 + ;; +]} + +Linebreak after `#`: + +{[ + # let x = 2 in + x + 1 + ;; +]} + +Invalid toplevel phrase/ocaml block: +{[ + - : int = + 4 +]} diff --git a/test/passing/refs.janestreet/docstrings_toplevel_directives.mlt.ref b/test/passing/refs.janestreet/docstrings_toplevel_directives.mlt.ref new file mode 100644 index 0000000000..689a15caf3 --- /dev/null +++ b/test/passing/refs.janestreet/docstrings_toplevel_directives.mlt.ref @@ -0,0 +1,11 @@ +(** Header *) + +#use "something" + +let two = 2 + +[@@@warning "-labels-omitted"];; + +Clflags.strict_sequence := false + +let f () = x diff --git a/test/passing/refs.janestreet/dune b/test/passing/refs.janestreet/dune new file mode 100644 index 0000000000..1ddf72ce93 --- /dev/null +++ b/test/passing/refs.janestreet/dune @@ -0,0 +1 @@ +(include ../gen/dune.inc) diff --git a/test/passing/refs.janestreet/dune-project b/test/passing/refs.janestreet/dune-project new file mode 100644 index 0000000000..c5d3ee94db --- /dev/null +++ b/test/passing/refs.janestreet/dune-project @@ -0,0 +1 @@ +(lang dune 2.2) diff --git a/test/passing/refs.janestreet/eliom_ext.eliom.err b/test/passing/refs.janestreet/eliom_ext.eliom.err new file mode 100644 index 0000000000..8f9ba22272 --- /dev/null +++ b/test/passing/refs.janestreet/eliom_ext.eliom.err @@ -0,0 +1 @@ +Warning: eliom_ext.eliom:53 exceeds the margin diff --git a/test/passing/refs.janestreet/eliom_ext.eliom.ref b/test/passing/refs.janestreet/eliom_ext.eliom.ref new file mode 100644 index 0000000000..6577938b74 --- /dev/null +++ b/test/passing/refs.janestreet/eliom_ext.eliom.ref @@ -0,0 +1,55 @@ +let%server log str = Lwt_io.write_line Lwt_io.stdout str +let%client log = ~%(Eliom_client.server_function [%derive.json: string] log) + +let%client () = + Eliom_client.onload + (* NB The service underlying the server_function isn't available on the + client before loading the page. *) + (fun () -> Lwt.async (fun () -> log "Hello from the client to the server!")) +;; + +let%client () = + Eliom_client.onload + (* NB The service underlying the server_function isn't available on the + client before loading the page. *) + ~foo:(fun () -> Lwt.async (fun () -> log "Hello from the client to the server!")) +;; + +let%client () = + Eliom_client.onload + (* NB The service underlying the server_function isn't available on the + client before loading the page. *) + ~foo:(fun () -> Lwt.async (fun () -> log "Hello from the client to the server!")) + bar +;; + +[%%shared + type some_type = int * string list [@@deriving json] + + type another_type = + | A of some_type + | B of another_type + [@@deriving json]] + +let%server + ( (s : int Eliom_shared.React.S.t) + , (f : (?step:React.step -> int -> unit) Eliom_shared.Value.t) ) + = + Eliom_shared.React.S.create 0 +;; + +let%client incr_s () = + let v = Eliom_shared.React.S.value ~%s in + ~%f (v + 1) +;; + +let%shared msg_of_int i = Printf.sprintf "value is %d" i + +let s_as_string () : string Eliom_shared.React.S.t = + Eliom_shared.React.S.map [%shared msg_of_int] s +;; + +let%shared () = + Eliom_registration.Html.register s (fun () () -> + Lwt.return (Eliom_tools.F.html ~title:"hybrid" Html.F.(body [ h1 [ txt "Salut !" ] ]))) +;; diff --git a/test/passing/refs.janestreet/empty_ml.ml.ref b/test/passing/refs.janestreet/empty_ml.ml.ref new file mode 100644 index 0000000000..079a31cf58 --- /dev/null +++ b/test/passing/refs.janestreet/empty_ml.ml.ref @@ -0,0 +1,3 @@ +(* test *) + +(* test *) diff --git a/test/passing/refs.janestreet/empty_mli.mli.ref b/test/passing/refs.janestreet/empty_mli.mli.ref new file mode 100644 index 0000000000..079a31cf58 --- /dev/null +++ b/test/passing/refs.janestreet/empty_mli.mli.ref @@ -0,0 +1,3 @@ +(* test *) + +(* test *) diff --git a/test/passing/refs.janestreet/empty_mlt.mlt.ref b/test/passing/refs.janestreet/empty_mlt.mlt.ref new file mode 100644 index 0000000000..079a31cf58 --- /dev/null +++ b/test/passing/refs.janestreet/empty_mlt.mlt.ref @@ -0,0 +1,3 @@ +(* test *) + +(* test *) diff --git a/test/passing/refs.janestreet/error1.ml.err b/test/passing/refs.janestreet/error1.ml.err new file mode 100644 index 0000000000..1f7352e78a --- /dev/null +++ b/test/passing/refs.janestreet/error1.ml.err @@ -0,0 +1,3 @@ +ocamlformat: ignoring "error1.ml" (syntax error) +File "error1.ml", line 2, characters 0-0: +Error: Syntax error diff --git a/test/passing/refs.janestreet/error2.ml.err b/test/passing/refs.janestreet/error2.ml.err new file mode 100644 index 0000000000..80ff306043 --- /dev/null +++ b/test/passing/refs.janestreet/error2.ml.err @@ -0,0 +1,5 @@ +ocamlformat: ignoring "error2.ml" (syntax error) +File "error2.ml", line 1, characters 0-1: +1 | "asdd + ^ +Error: String literal not terminated diff --git a/test/passing/refs.janestreet/error3.ml.err b/test/passing/refs.janestreet/error3.ml.err new file mode 100644 index 0000000000..e42c4128f0 --- /dev/null +++ b/test/passing/refs.janestreet/error3.ml.err @@ -0,0 +1,11 @@ +ocamlformat: ignoring "error3.ml" (misplaced documentation comments - warning 50) +File "error3.ml", line 2, characters 0-13: +2 | (** a or b *) + ^^^^^^^^^^^^^ +Warning 50 [unexpected-docstring]: ambiguous documentation comment + +File "error3.ml", line 3, characters 8-16: +3 | let b = (** ? *) () + ^^^^^^^^ +Warning 50 [unexpected-docstring]: unattached documentation comment (ignored) +Hint: (Warning 50) This file contains a documentation comment (** ... *) that the OCaml compiler does not know how to attach to the AST. OCamlformat does not support these cases. You can find more information at: https://github.com/ocaml-ppx/ocamlformat#overview. If you'd like to disable this check and let ocamlformat make a choice (though it might not be consistent with the ocaml compilers and odoc), you can set the --no-comment-check option. diff --git a/test/passing/refs.janestreet/error4.ml.err b/test/passing/refs.janestreet/error4.ml.err new file mode 100644 index 0000000000..0a5b3b1a49 --- /dev/null +++ b/test/passing/refs.janestreet/error4.ml.err @@ -0,0 +1,9 @@ +File "error4.ml", line 2, characters 0-13: +2 | (** a or b *) + ^^^^^^^^^^^^^ +Warning 50 [unexpected-docstring]: ambiguous documentation comment + +File "error4.ml", line 3, characters 8-16: +3 | let b = (** ? *) () + ^^^^^^^^ +Warning 50 [unexpected-docstring]: unattached documentation comment (ignored) diff --git a/test/passing/refs.janestreet/error4.ml.ref b/test/passing/refs.janestreet/error4.ml.ref new file mode 100644 index 0000000000..694725ec0a --- /dev/null +++ b/test/passing/refs.janestreet/error4.ml.ref @@ -0,0 +1,5 @@ +(** a or b *) +let a = () + +(** a or b *) +let b = (** ? *) () diff --git a/test/passing/refs.janestreet/escaped_nl.ml.ref b/test/passing/refs.janestreet/escaped_nl.ml.ref new file mode 100644 index 0000000000..1dfdb8b6ad --- /dev/null +++ b/test/passing/refs.janestreet/escaped_nl.ml.ref @@ -0,0 +1,24 @@ +let s1 = + "No field 'install', but a field 'remove': install instructions probably part of \ + 'build'. Use the 'install' field or a .install file" +;; + +let x = + cond + 40 + `Warning + "Package uses flags that aren't recognised by earlier versions in OPAM 1.2 branch. \ + At the moment, you should use a tag \"flags:foo\" instead for compatibility" + ~detail:alpha_flags + (alpha_flags <> []) +;; + +let s2 = "bla bla\n bli bli blo" +let s3 = "" +let s4 = " " +let s5 = " " +let s6 = "\n" +let s7 = " \n" +let c1 = '\n' +let x1 = f x '\n' y z +let zz = "\ns " diff --git a/test/passing/refs.janestreet/exceptions.ml.ref b/test/passing/refs.janestreet/exceptions.ml.ref new file mode 100644 index 0000000000..cbfe4404b8 --- /dev/null +++ b/test/passing/refs.janestreet/exceptions.ml.ref @@ -0,0 +1,68 @@ +exception EvalError of Error.t [@@deriving sexp] +exception Duplicate_found of (unit -> Base.Sexp.t) * string +exception Duplicate_found of ((unit -> Base.Sexp.t) -> string) + +type t = Duplicate_found of (unit -> Base.Sexp.t) * string +type t = Duplicate_found : (unit -> Base.Sexp.t) * string -> t +type t = Duplicate_found : ((unit -> Base.Sexp.t) -> string) -> t + +module type S = sig + exception EvalError of Error.t [@@deriving sexp] + exception Duplicate_found of (unit -> Base.Sexp.t) * string + exception Duplicate_found of ((unit -> Base.Sexp.t) -> string) + + type t = Duplicate_found of (unit -> Base.Sexp.t) * string + type t = Duplicate_found : (unit -> Base.Sexp.t) * string -> t + type t = Duplicate_found : ((unit -> Base.Sexp.t) -> string) -> t +end + +let _ = + let exception Duplicate_found of (unit -> Base.Sexp.t) * string in + let exception Duplicate_found of ((unit -> Base.Sexp.t) -> string) in + () +;; + +exception Recursion_error of (Lv6Id.long as 'id) * (string list as 'stack) + +exception + Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string | `Unstable of Location.t * string ] + ] + +exception E : _ +exception E : t +exception E : [%ext t] +exception E : (t as 'a) +exception E : (t * t) +exception E : (t -> t) +exception E : (module M) +exception E : [ `X | `Y ] +exception E : 'x +exception E : < x ; y ; .. > +exception E : #c +exception E : t #c +exception E : (t -> t) #c +exception E : a b #c +exception E : (a * b) #c +exception E : (a, b) #c +exception E : (t -> t) #c +exception E : (t as 'a) #c +exception E of _ +exception E of t +exception E of [%ext t] +exception E of (t as 'a) +exception E of (t * t) +exception E of (t -> t) +exception E of (module M) +exception E of [ `X | `Y ] +exception E of 'x +exception E of < x ; y ; .. > +exception E of #c +exception E of t #c +exception E of (t -> t) #c +exception E of a b #c +exception E of (a * b) #c +exception E of (a, b) #c +exception E of (t -> t) #c +exception E of (t as 'a) #c diff --git a/test/passing/refs.janestreet/exceptions.mli.ref b/test/passing/refs.janestreet/exceptions.mli.ref new file mode 100644 index 0000000000..8aa24601b0 --- /dev/null +++ b/test/passing/refs.janestreet/exceptions.mli.ref @@ -0,0 +1,62 @@ +exception EvalError of Error.t [@@deriving sexp] +exception Duplicate_found of (unit -> Base.Sexp.t) * string +exception Duplicate_found of ((unit -> Base.Sexp.t) -> string) + +type t = Duplicate_found of (unit -> Base.Sexp.t) * string +type t = Duplicate_found : (unit -> Base.Sexp.t) * string -> t +type t = Duplicate_found : ((unit -> Base.Sexp.t) -> string) -> t + +module type S = sig + exception EvalError of Error.t [@@deriving sexp] + exception Duplicate_found of (unit -> Base.Sexp.t) * string + exception Duplicate_found of ((unit -> Base.Sexp.t) -> string) + + type t = Duplicate_found of (unit -> Base.Sexp.t) * string + type t = Duplicate_found : (unit -> Base.Sexp.t) * string -> t + type t = Duplicate_found : ((unit -> Base.Sexp.t) -> string) -> t +end + +exception Recursion_error of (Lv6Id.long as 'id) * (string list as 'stack) + +exception + Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string | `Unstable of Location.t * string ] + ] + +exception E : _ +exception E : t +exception E : [%ext t] +exception E : (t as 'a) +exception E : (t * t) +exception E : (t -> t) +exception E : (module M) +exception E : [ `X | `Y ] +exception E : 'x +exception E : < x ; y ; .. > +exception E : #c +exception E : t #c +exception E : (t -> t) #c +exception E : a b #c +exception E : (a * b) #c +exception E : (a, b) #c +exception E : (t -> t) #c +exception E : (t as 'a) #c +exception E of _ +exception E of t +exception E of [%ext t] +exception E of (t as 'a) +exception E of (t * t) +exception E of (t -> t) +exception E of (module M) +exception E of [ `X | `Y ] +exception E of 'x +exception E of < x ; y ; .. > +exception E of #c +exception E of t #c +exception E of (t -> t) #c +exception E of a b #c +exception E of (a * b) #c +exception E of (a, b) #c +exception E of (t -> t) #c +exception E of (t as 'a) #c diff --git a/test/passing/refs.janestreet/exp_grouping-parens.ml.ref b/test/passing/refs.janestreet/exp_grouping-parens.ml.ref new file mode 100644 index 0000000000..11e55d5d2d --- /dev/null +++ b/test/passing/refs.janestreet/exp_grouping-parens.ml.ref @@ -0,0 +1,411 @@ +let () = + Lwt_main.run + (let a = "a" in + let b = "b" in + let c = "c" in + Lwt.return "test") +;; + +let () = + Lwt_main.run + (let a = "a" in + let b = "b" in + let c = "c" in + Lwt.return "test") +;; + +let () = + List.iter + (fun v -> + (* do a lot of things *) + let a = "a" in + let b = "b" in + let c = "c" in + ()) + values +;; + +let () = + List.iter + (fun v -> + (* do a lot of things *) + let a = "a" in + let b = "b" in + let c = "c" in + ()) + values +;; + +let () = + foooooooo + (fooooooooooooo; + foooooooo foooooooooooo; + fooooooooooo foooooooooo; + foooooooooooooooo) +;; + +let () = + foooooooo + (fooooooooooooo; + foooooooo foooooooooooo; + fooooooooooo foooooooooo; + foooooooooooooooo) +;; + +let () = + foooooooo + (if foooooooooooooooooooooooooooo + then + if foooooooooooooooooooooooooooo + then foooooooooooooooooo + else foooooooooooooooooooooooooo + else if foooooooooooooooooooooooooooooooo + then + foooooooooooooooooo + (if foooooooooooooooooooooooooooo + then + if foooooooooooooooooooooooooooo + then foooooooooooooooooooooooo + else foooooooooooooooooooooooooo + else if foooooooooooooooooooooooooooooooo + then fooooooooooooooooooooooooooooooooooo + else if foooooooooooooooooo + then foooooooooooooooooooooooooooooooooo + else fooooooooooooooooooooo) + else if foooooooooooooooooo + then foooooooooooooooooooooooooooooooooo + else fooooooooooooooooooooo) +;; + +let () = + foooooooo + (if foooooooooooooooooooooooooooo + then + if foooooooooooooooooooooooooooo + then foooooooooooooooooooooooo + else + foooooooooooooooooooooooooooo + (if foooooooooooooooooooooooooooo + then + if foooooooooooooooooooooooooooo + then foooooooooooooooooooooooo + else foooooooooooooooooooooooooo + else if foooooooooooooooooooooooooooooooo + then fooooooooooooooooooooooooooooooooooo + else if foooooooooooooooooo + then foooooooooooooooooooooooooooooooooo + else fooooooooooooooooooooo) + else if foooooooooooooooooooooooooooooooo + then fooooooooooooooooooooooooooooooooooo + else if foooooooooooooooooo + then foooooooooooooooooooooooooooooooooo + else fooooooooooooooooooooo) +;; + +let _ = + a + |> + let a = b in + c +;; + +let _ = + (let a = b in + c) + |> d +;; + +let _ = + a + := let a = b in + c +;; + +let _ = + (let a = b in + c) + := d +;; + +let _ = + a + + + let a = b in + c +;; + +let _ = + (let a = b in + c) + + d +;; + +let _ = + f + (let a = b in + c) +;; + +let _ = + (let a = b in + c) + d +;; + +let _ = + a#f + (let a = b in + c) +;; + +let _ = + (let a = b in + c) + #f +;; + +let _ = + A + (let a = b in + c) +;; + +let _ = + `A + (let a = b in + c) +;; + +let _ = + { x = + (let a = b in + c) + } +;; + +let _ = + { (let a = b in + c) + with + a = b + } +;; + +let _ = + {<x = let a = b in + c>} +;; + +let _ = + x + <- (let a = b in + c) +;; + +let _ = + (let a = b in + c) + .x +;; + +let _ = + (let a = b in + c).x + <- d +;; + +let _ = + ( (let a = b in + c) + , d ) +;; + +let _ = + (let a = b in + c + :> t) +;; + +let _ = + let a = b in + c :: d +;; + +let _ = + a + :: + (let a = b in + c) +;; + +let _ = + [ (let a = b in + c) + ] +;; + +let _ = + [| (let a = b in + c) + |] +;; + +let () = if a then b (* asd *) + +[@@@ocamlformat "if-then-else=compact"] + +let _ = + if x then ( + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo) + else if y then ( + f 0; + f 2) + else ( + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo) +;; + +let () = if a then b (* asd *) + +[@@@ocamlformat "if-then-else=fit-or-vertical"] + +let _ = + if x then ( + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo) + else if y then ( + f 0; + f 2) + else ( + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo) +;; + +let () = + if a then + b (* asd *) +;; + +[@@@ocamlformat "if-then-else=keyword-first"] + +let _ = + if x + then ( + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo) + else if y + then ( + f 0; + f 2) + else ( + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo) +;; + +let () = if a then b (* asd *) + +[@@@ocamlformat "if-then-else=k-r"] + +let _ = + if x then ( + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + ) else if y then ( + f 0; + f 2 + ) else ( + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + ) +;; + +let _ = + match x with + | A -> + (match B with + | A -> fooooooooooooo) + | A -> + (match B with + | A -> fooooooooooooo + | B -> fooooooooooooo) + | A -> + (match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + | C -> fooooooooooooo + | D -> fooooooooooooo) +;; + +let () = + (add_test + @@ + let test_name = "Test 1" in + test_name >:: fun _ -> assert_equal "a" "a"); + add_test + @@ + let test_name = "Test 2" in + test_name >:: fun _ -> assert_equal "b" "b" +;; + +let _ = () +let _ = ( (* foo *) ) +let _ = [%ext ()] +let _ = [%ext (* foo *) ()] +let _ = x y +let _ = (* foo *) x y +let _ = [%ext x y] +let _ = [%ext (* foo *) x y] + +let _ = + begin [@landmark "parse_constant_dividends"] + market_data_items := () + end +;; + +let () = if a then b (* asd *) + +let x = + let get_path_and_distance pv1 pv2 = + if is_loop pv1 pv2 then + Some ([], 0) + else ( + match Tbl.find dist_tbl (pv1, pv2) with + | None -> + (* FIXME: temporary hack to avoid Jane Street's annoying warnings. *) + begin [@warning "-3"] + try + let path', dist = Dijkstra.shortest_path pgraph pv1 pv2 in + let path = unwrap_path path' in + Tbl.set dist_tbl ~key:(pv1, pv2) ~data:(path, dist); + Some (path, dist) + with + | Not_found | Not_found_s _ -> None + end + | pd -> pd + ) + in + () +;; + +let _ = + if something_changed then + begin [@attr] + loop + end +;; + +let _ = + match x with + | _ -> + (* xxx *) + y +;; + +let _ = + match x with + | _ -> + begin [@foo] + y + end +;; diff --git a/test/passing/refs.janestreet/exp_grouping.ml.ref b/test/passing/refs.janestreet/exp_grouping.ml.ref new file mode 100644 index 0000000000..85b6f8f747 --- /dev/null +++ b/test/passing/refs.janestreet/exp_grouping.ml.ref @@ -0,0 +1,480 @@ +let () = + Lwt_main.run + begin + let a = "a" in + let b = "b" in + let c = "c" in + Lwt.return "test" + end +;; + +let () = + Lwt_main.run + (let a = "a" in + let b = "b" in + let c = "c" in + Lwt.return "test") +;; + +let () = + List.iter + begin + fun v -> + (* do a lot of things *) + let a = "a" in + let b = "b" in + let c = "c" in + () + end + values +;; + +let () = + List.iter + (fun v -> + (* do a lot of things *) + let a = "a" in + let b = "b" in + let c = "c" in + ()) + values +;; + +let () = + foooooooo + begin + fooooooooooooo; + foooooooo foooooooooooo; + fooooooooooo foooooooooo; + foooooooooooooooo + end +;; + +let () = + foooooooo + (fooooooooooooo; + foooooooo foooooooooooo; + fooooooooooo foooooooooo; + foooooooooooooooo) +;; + +let () = + foooooooo + begin + if foooooooooooooooooooooooooooo + then + if foooooooooooooooooooooooooooo + then foooooooooooooooooo + else foooooooooooooooooooooooooo + else if foooooooooooooooooooooooooooooooo + then + foooooooooooooooooo + begin + if foooooooooooooooooooooooooooo + then + if foooooooooooooooooooooooooooo + then foooooooooooooooooooooooo + else foooooooooooooooooooooooooo + else if foooooooooooooooooooooooooooooooo + then fooooooooooooooooooooooooooooooooooo + else if foooooooooooooooooo + then foooooooooooooooooooooooooooooooooo + else fooooooooooooooooooooo + end + else if foooooooooooooooooo + then foooooooooooooooooooooooooooooooooo + else fooooooooooooooooooooo + end +;; + +let () = + foooooooo + (if foooooooooooooooooooooooooooo + then + if foooooooooooooooooooooooooooo + then foooooooooooooooooooooooo + else + foooooooooooooooooooooooooooo + (if foooooooooooooooooooooooooooo + then + if foooooooooooooooooooooooooooo + then foooooooooooooooooooooooo + else foooooooooooooooooooooooooo + else if foooooooooooooooooooooooooooooooo + then fooooooooooooooooooooooooooooooooooo + else if foooooooooooooooooo + then foooooooooooooooooooooooooooooooooo + else fooooooooooooooooooooo) + else if foooooooooooooooooooooooooooooooo + then fooooooooooooooooooooooooooooooooooo + else if foooooooooooooooooo + then foooooooooooooooooooooooooooooooooo + else fooooooooooooooooooooo) +;; + +let _ = + a + |> + let a = b in + c +;; + +let _ = + (let a = b in + c) + |> d +;; + +let _ = + a + := let a = b in + c +;; + +let _ = + (let a = b in + c) + := d +;; + +let _ = + a + + + let a = b in + c +;; + +let _ = + (let a = b in + c) + + d +;; + +let _ = + f + (let a = b in + c) +;; + +let _ = + (let a = b in + c) + d +;; + +let _ = + a#f + (let a = b in + c) +;; + +let _ = + (let a = b in + c) + #f +;; + +let _ = + A + (let a = b in + c) +;; + +let _ = + `A + (let a = b in + c) +;; + +let _ = + { x = + (let a = b in + c) + } +;; + +let _ = + { (let a = b in + c) + with + a = b + } +;; + +let _ = + {<x = let a = b in + c>} +;; + +let _ = + x + <- (let a = b in + c) +;; + +let _ = + (let a = b in + c) + .x +;; + +let _ = + (let a = b in + c).x + <- d +;; + +let _ = + ( (let a = b in + c) + , d ) +;; + +let _ = + (let a = b in + c + :> t) +;; + +let _ = + let a = b in + c :: d +;; + +let _ = + a + :: + (let a = b in + c) +;; + +let _ = + [ (let a = b in + c) + ] +;; + +let _ = + [| (let a = b in + c) + |] +;; + +let () = + if a + then begin + b (* asd *) + end +;; + +[@@@ocamlformat "if-then-else=compact"] + +let _ = + if x then begin + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + end + else if y then begin + f 0; + f 2 + end + else begin + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + end +;; + +let () = + if a then begin b + (* asd *) + end +;; + +[@@@ocamlformat "if-then-else=fit-or-vertical"] + +let _ = + if x then begin + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + end + else if y then begin + f 0; + f 2 + end + else begin + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + end +;; + +let () = + if a then begin + b + (* asd *) + end +;; + +[@@@ocamlformat "if-then-else=keyword-first"] + +let _ = + if x + then begin + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + end + else if y + then begin + f 0; + f 2 + end + else begin + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + end +;; + +let () = + if a + then begin + b (* asd *) + end +;; + +[@@@ocamlformat "if-then-else=k-r"] + +let _ = + if x then begin + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + end else if y then begin + f 0; + f 2 + end else begin + foo.fooooo <- Fooo.foo fooo foo.fooooo; + Fooo fooo + end +;; + +let _ = + match x with + | A -> begin + match B with + | A -> fooooooooooooo + end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + end + | A -> begin + match B with + | A -> fooooooooooooo + | B -> fooooooooooooo + | C -> fooooooooooooo + | D -> fooooooooooooo + end +;; + +let () = + begin + add_test + @@ + let test_name = "Test 1" in + test_name >:: fun _ -> assert_equal "a" "a" + end; + begin + add_test + @@ + let test_name = "Test 2" in + test_name >:: fun _ -> assert_equal "b" "b" + end +;; + +let _ = () +let _ = ( (* foo *) ) +let _ = [%ext ()] +let _ = [%ext (* foo *) ()] + +let _ = + begin + x y + end +;; + +let _ = + begin + (* foo *) x y + end +;; + +let _ = + begin%ext + x y + end +;; + +let _ = + begin%ext + (* foo *) x y + end +;; + +let _ = + begin [@landmark "parse_constant_dividends"] + market_data_items := () + end +;; + +let () = + if a then begin + b + (* asd *) + end +;; + +let x = + let get_path_and_distance pv1 pv2 = + if is_loop pv1 pv2 then + Some ([], 0) + else ( + match Tbl.find dist_tbl (pv1, pv2) with + | None -> + (* FIXME: temporary hack to avoid Jane Street's annoying warnings. *) + begin [@warning "-3"] + try + let path', dist = Dijkstra.shortest_path pgraph pv1 pv2 in + let path = unwrap_path path' in + Tbl.set dist_tbl ~key:(pv1, pv2) ~data:(path, dist); + Some (path, dist) + with + | Not_found | Not_found_s _ -> None + end + | pd -> pd + ) + in + () +;; + +let _ = + if something_changed then + begin [@attr] + loop + end +;; + +let _ = + match x with + | _ -> + (* xxx *) + begin + y + end +;; + +let _ = + match x with + | _ -> + begin [@foo] + y + end +;; diff --git a/test/passing/refs.janestreet/exp_record.ml.ref b/test/passing/refs.janestreet/exp_record.ml.ref new file mode 100644 index 0000000000..30ab8329fe --- /dev/null +++ b/test/passing/refs.janestreet/exp_record.ml.ref @@ -0,0 +1,9 @@ +let x = { a = 1; b = true } +let x = { a : int = b } +let x { a : int = b } = 2 + +[@@@ocamlformat "space-around-records"] + +let x = { a = 1; b = true } +let x = { a : int = b } +let x { a : int = b } = 2 diff --git a/test/passing/refs.janestreet/expect_test.ml.err b/test/passing/refs.janestreet/expect_test.ml.err new file mode 100644 index 0000000000..32b571a212 --- /dev/null +++ b/test/passing/refs.janestreet/expect_test.ml.err @@ -0,0 +1,2 @@ +Warning: expect_test.ml:14 exceeds the margin +Warning: expect_test.ml:24 exceeds the margin diff --git a/test/passing/refs.janestreet/expect_test.ml.ref b/test/passing/refs.janestreet/expect_test.ml.ref new file mode 100644 index 0000000000..b0f95b8bd2 --- /dev/null +++ b/test/passing/refs.janestreet/expect_test.ml.ref @@ -0,0 +1,26 @@ +let%expect_test _ = e +let%bench "test" = fun () -> () + +let%expect_test _ = + assert false; + [%expect.unreachable] +[@@expect.uncaught_exn + {| + (* CR expect_test_collector: This test expectation appears to contain a backtrace. + This is strongly discouraged as backtraces are fragile. + Please change this test to not include a backtrace. *) + + "Assert_failure test.ml:5:6" + Raised at file "test.ml", line 4, characters 6-18 + Called from file "collector/expect_test_collector.ml", line 225, characters 12-19 |}] +;; + +let _ = + assert false; + [%expect.unreachable] +[@@expect.uncaught_exn + {| + "Assert_failure test.ml:5:6" + Raised at file "test.ml", line 4, characters 6-18 + Called from file "collector/expect_test_collector.ml", line 225, characters 12-19 |}] +;; diff --git a/test/passing/refs.janestreet/extensions-indent.ml.ref b/test/passing/refs.janestreet/extensions-indent.ml.ref new file mode 100644 index 0000000000..5da7e84ae5 --- /dev/null +++ b/test/passing/refs.janestreet/extensions-indent.ml.ref @@ -0,0 +1,701 @@ +let () = + [%ext expr]; + () +;; + +let _ = + (match%ext x with + | () -> ()) + [@attr y] +;; + +let _ = + match%ext x with + | () -> + let y = [%test let x = y] in + let%test x = d in + d +;; + +val f : compare:[%compare: 'a] -> sexp_of:[%sexp_of: 'a] -> t + +let invariant t = + Invariant.invariant [%here] t [%sexp_of: t] (fun () -> assert (check_t_invariant t)) +;; + +[%e? + ( xxxxxxxxx + , xxxxxxxxxxxxx + , xxxxxxxxxxxxxxxx + , xxxxxxxxxxxxxx + , xxxxxxxxxxx + , xxxxxxxxxxxxxxxxxxxx )] +;; + +[%e? + ( xxxxxxxxx + , xxxxxxxxxxxxx + , xxxxxxxxxxxxxxxx + , xxxxxxxxxxxxxx + , xxxxxxxxxxx + , xxxxxxxxxxxxxxxxxxxx ) when a < b] + [%ext + let f = () + and g () = () in + e] + (let%ext f = () + and g () = () in + e) + [%ext + let rec f = () + and g () = () in + e] + (let%ext rec f = () + and g () = () in + e) + +let _ = ([%ext? (x : x)] : [%ext? (x : x)]) + +[%%ext 11111111111111111111] +[%%ext 11111111111111111111111 22222222222222222222222 33333333333333333333333] + +[%%ext + 11111111111111111111;; + 22222222222222222222] + +[%%ext + 11111111111111111111;; + 22222222222222222222;; + 33333333333333333333] + +[%%ext + let foooooooooooooooo = foooo + let fooooooooooooooo = foo] + +let _ = [%stri let [%p xxx] = fun (t : [%t tt]) (ut : [%t tt]) -> [%e xxx]] + +let _ = + [ x + ; x + ---> [%expr + [%e x ~loc [%expr x] x]; + iter tail] + ; x + ] +;; + +let _ = + [%expr + let x = e in + f y] + [@x] +;; + +let _ = + f + (for i = 0 to 1 do + () + done) + (while true do + () + done) +;; + +let _ = + f + (for%ext i = 0 to 1 do + () + done) + (while%ext true do + () + done) +;; + +let _ = + function%ext + | x -> x +;; + +let _ = + f + (function%ext + | x -> x) +;; + +let _ = + f + (function%ext + | x -> x) + x +;; + +let _ = + [%ext + function + | x -> x] +;; + +let _ = + f + [%ext + function + | x -> x] +;; + +let _ = + f + [%ext + function + | x -> x] + x +;; + +let _ = f ([%ext e] [@attr]) x + +let _ = + a;%ext + b; + [%ext + a; + b] +;; + +let _ = + try%lwt Lwt.return 2 with + | _ -> assert false +;; + +let _ = + (* foooooooooooo *) + try%lwt + (* fooooooooooo *) + Lwt.return 2 + with + | _ -> assert false +;; + +let _ = + try%lwt + let a = 3 in + Lwt.return a + with + | _ -> assert false +;; + +let _ = + (* foooooooooooo *) + try%lwt + (* fooooooooooo *) + let a = 3 in + Lwt.return a + with + | _ -> assert false +;; + +let%lwt f = function + | _ -> () +;; + +type%any_extension t = < a : 'a > + +let value = + f + [%any_extension + function + | 0 -> false + | _ -> true] +;; + +let value = [%any_extension fun x -> y] x + +let value = + f + [%any_extension + try x with + | x -> false + | _ -> true] +;; + +let value = + f + [%any_extension + match x with + | x -> false + | _ -> true] +;; + +let foo = + [%foooooooooo + fooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] +[@@foooooooooo + fooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] +;; + +[%%foooooooooo: + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[@@@foooooooooo + fooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +let _ = + [%ext + let+ a = b in + c] +;; + +let _ = + [%ext + "foo"; + "bar"] +;; + +let this_function_has_a_long_name plus very many arguments = "and a kind of long body" + +[%%expect {||}];; + +[%expect + {| +___________________________________________________________ +|}] + +[%%expect + {| +___________________________________________________________ +|}] + +let () = + (* -1 *) + [%(* 0 *) + (* 0.5 *) + test + () (* 1 *) [@foo (* 2 *) "bar"] (* 3 *)] +;; + +open%ext M + +[%%ext open M] + +open! %ext M + +[%%ext open! M] + +include%ext M + +[%%ext include M] + +let x = + let open%ext M in + x +;; + +let x = + [%ext + let open M in + x] +;; + +let x = + let open! %ext M in + x +;; + +let x = + [%ext + let open! M in + x] +;; + +exception%ext E + +[%%ext exception E] + +let _ = + let exception%ext E in + x +;; + +let _ = + [%ext + let exception E in + x] +;; + +module%ext E = P + +[%%ext module E = P] + +module%ext rec K = A +and L = A + +[%%ext + module rec K = A + and L = A] + +let _ = + let module%ext E = P in + x +;; + +let _ = + [%ext + let module E = P in + x] +;; + +module type%ext E = P + +[%%ext module type E = P] + +class%ext x = y + +[%%ext class x = y] + +class%ext x = y + +and y = z + +[%%ext + class x = y + + and y = z] + +class type%ext x = y + +[%%ext class type x = y] + +class type%ext x = y + +and y = z + +[%%ext + class type x = y + + and y = z] + +let _ = (* bar *) [%expr (* comment *) foo (* blabla *)] +let _ = assert%lwt false +let _ = [%lwt assert false] +let _ = f (assert%lwt false) +let _ = f [%lwt assert false] +let _ = (assert%lwt false) [@attr] +let _ = [%lwt assert false] [@attr] +let _ = f ((assert%lwt false) [@attr]) +let _ = f ([%lwt assert false] [@attr]) +let _ = lazy%ext e +let _ = [%ext lazy e] +let _ = f (lazy%ext e) +let _ = f [%ext lazy e] +let _ = (lazy%ext e) [@attr] +let _ = [%ext lazy e] [@attr] +let _ = f ((lazy%ext e) [@attr]) +let _ = f ([%ext lazy e] [@attr]) + +let _ = + object%ext + method x = y + end +;; + +let _ = + [%ext + object + method x = y + end] +;; + +let _ = + f + (object%ext + method x = y + end) +;; + +let _ = + f + [%ext + object + method x = y + end] +;; + +let _ = + (object%ext + method x = y + end) + [@attr] +;; + +let _ = + [%ext + object + method x = y + end] + [@attr] +;; + +let _ = + f + ((object%ext + method x = y + end) + [@attr]) +;; + +let _ = + f + ([%ext + object + method x = y + end] + [@attr]) +;; + +let _ = if%ext x then y else z +let _ = [%ext if x then y else z] +let _ = f (if%ext x then y else z) +let _ = f [%ext if x then y else z] +let _ = (if%ext x then y else z) [@attr] +let _ = [%ext if x then y else z] [@attr] +let _ = f ((if%ext x then y else z) [@attr]) +let _ = f ([%ext if x then y else z] [@attr]) + +let _ = + match%ext x with + | _ -> x +;; + +let _ = + [%ext + match x with + | _ -> x] +;; + +let _ = + f + (match%ext x with + | _ -> x) +;; + +let _ = + f + [%ext + match x with + | _ -> x] +;; + +let _ = + (match%ext x with + | _ -> x) + [@attr] +;; + +let _ = + [%ext + match x with + | _ -> x] + [@attr] +;; + +let _ = + f + ((match%ext x with + | _ -> x) + [@attr]) +;; + +let _ = + f + ([%ext + match x with + | _ -> x] + [@attr]) +;; + +let _ = + try%ext x with + | _ -> x +;; + +let _ = + [%ext + try x with + | _ -> x] +;; + +let _ = + f + (try%ext x with + | _ -> x) +;; + +let _ = + f + [%ext + try x with + | _ -> x] +;; + +let _ = + (try%ext x with + | _ -> x) + [@attr] +;; + +let _ = + [%ext + try x with + | _ -> x] + [@attr] +;; + +let _ = + f + ((try%ext x with + | _ -> x) + [@attr]) +;; + +let _ = + f + ([%ext + try x with + | _ -> x] + [@attr]) +;; + +let _ = fun%ext x -> x +let _ = [%ext fun x -> x] +let _ = f (fun%ext x -> x) +let _ = f [%ext fun x -> x] +let _ = (fun%ext x -> x) [@attr] +let _ = [%ext fun x -> x] [@attr] +let _ = f ((fun%ext x -> x) [@attr]) +let _ = f ([%ext fun x -> x] [@attr]) + +let _ = + function%ext + | x -> x +;; + +let _ = + [%ext + function + | x -> x] +;; + +let _ = + f + (function%ext + | x -> x) +;; + +let _ = + f + [%ext + function + | x -> x] +;; + +let _ = + (function%ext + | x -> x) + [@attr] +;; + +let _ = + [%ext + function + | x -> x] + [@attr] +;; + +let _ = + f + ((function%ext + | x -> x) + [@attr]) +;; + +let _ = + f + ([%ext + function + | x -> x] + [@attr]) +;; + +let _ = new%ext x +let _ = [%ext new x] +let _ = f (new%ext x) +let _ = f [%ext new x] +let _ = (new%ext x) [@attr] +let _ = [%ext new x] [@attr] +let _ = f ((new%ext x) [@attr]) +let _ = f ([%ext new x] [@attr]) + +let _ = + x;%ext + y +;; + +let _ = + [%ext + x; + y] +;; + +let _ = + f + (x;%ext + y) +;; + +let _ = + f + [%ext + x; + y] +;; + +let _ = + (x;%ext + y) + [@attr] +;; + +let _ = + [%ext + x; + y] + [@attr] +;; + +let _ = + f + ((x;%ext + y) + [@attr]) +;; + +let _ = + f + ([%ext + x; + y] + [@attr]) +;; diff --git a/test/passing/refs.janestreet/extensions-indent.mli.ref b/test/passing/refs.janestreet/extensions-indent.mli.ref new file mode 100644 index 0000000000..5dae717a92 --- /dev/null +++ b/test/passing/refs.janestreet/extensions-indent.mli.ref @@ -0,0 +1,96 @@ +type%foo t = < .. > + +type t = + [%foooooooooo + fooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] +[@@foooooooooo + fooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%foooooooooo + fooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%foooooooooo: + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[@@@foooooooooo + fooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%ext + val foooooooooooooooooooooo : fooooooooooo + val fooooooooooooooooooooooooooo : fooooo] + +exception%ext E + +[%%ext exception E] + +include%ext M + +[%%ext include M] + +module type%ext T = M + +[%%ext module type T = M] + +module%ext T : M + +[%%ext: module T : M] + +module%ext rec T : M +and Z : Q + +[%%ext: + module rec T : M + and Z : Q] + +module%ext T := M + +[%%ext: module T := M] + +open%ext M +open! %ext M + +[%%ext open M] +[%%ext open! M] + +type%foo t += T + +[%%foo: type t += T] + +val%foo x : t + +[%%foo: val x : t] + +external%foo x : t = "" + +[%%foo: external x : t = ""] + +class%foo x : t + +[%%foo: class x : t] + +class type%foo x = x + +[%%foo: class type x = x] + +type%ext t := x + +[%%ext: type t := x] diff --git a/test/passing/refs.janestreet/extensions.ml.ref b/test/passing/refs.janestreet/extensions.ml.ref new file mode 100644 index 0000000000..be54247713 --- /dev/null +++ b/test/passing/refs.janestreet/extensions.ml.ref @@ -0,0 +1,701 @@ +let () = + [%ext expr]; + () +;; + +let _ = + (match%ext x with + | () -> ()) + [@attr y] +;; + +let _ = + match%ext x with + | () -> + let y = [%test let x = y] in + let%test x = d in + d +;; + +val f : compare:[%compare: 'a] -> sexp_of:[%sexp_of: 'a] -> t + +let invariant t = + Invariant.invariant [%here] t [%sexp_of: t] (fun () -> assert (check_t_invariant t)) +;; + +[%e? + ( xxxxxxxxx + , xxxxxxxxxxxxx + , xxxxxxxxxxxxxxxx + , xxxxxxxxxxxxxx + , xxxxxxxxxxx + , xxxxxxxxxxxxxxxxxxxx )] +;; + +[%e? + ( xxxxxxxxx + , xxxxxxxxxxxxx + , xxxxxxxxxxxxxxxx + , xxxxxxxxxxxxxx + , xxxxxxxxxxx + , xxxxxxxxxxxxxxxxxxxx ) when a < b] + [%ext + let f = () + and g () = () in + e] + (let%ext f = () + and g () = () in + e) + [%ext + let rec f = () + and g () = () in + e] + (let%ext rec f = () + and g () = () in + e) + +let _ = ([%ext? (x : x)] : [%ext? (x : x)]) + +[%%ext 11111111111111111111] +[%%ext 11111111111111111111111 22222222222222222222222 33333333333333333333333] + +[%%ext + 11111111111111111111;; + 22222222222222222222] + +[%%ext + 11111111111111111111;; + 22222222222222222222;; + 33333333333333333333] + +[%%ext + let foooooooooooooooo = foooo + let fooooooooooooooo = foo] + +let _ = [%stri let [%p xxx] = fun (t : [%t tt]) (ut : [%t tt]) -> [%e xxx]] + +let _ = + [ x + ; x + ---> [%expr + [%e x ~loc [%expr x] x]; + iter tail] + ; x + ] +;; + +let _ = + [%expr + let x = e in + f y] + [@x] +;; + +let _ = + f + (for i = 0 to 1 do + () + done) + (while true do + () + done) +;; + +let _ = + f + (for%ext i = 0 to 1 do + () + done) + (while%ext true do + () + done) +;; + +let _ = + function%ext + | x -> x +;; + +let _ = + f + (function%ext + | x -> x) +;; + +let _ = + f + (function%ext + | x -> x) + x +;; + +let _ = + [%ext + function + | x -> x] +;; + +let _ = + f + [%ext + function + | x -> x] +;; + +let _ = + f + [%ext + function + | x -> x] + x +;; + +let _ = f ([%ext e] [@attr]) x + +let _ = + a;%ext + b; + [%ext + a; + b] +;; + +let _ = + try%lwt Lwt.return 2 with + | _ -> assert false +;; + +let _ = + (* foooooooooooo *) + try%lwt + (* fooooooooooo *) + Lwt.return 2 + with + | _ -> assert false +;; + +let _ = + try%lwt + let a = 3 in + Lwt.return a + with + | _ -> assert false +;; + +let _ = + (* foooooooooooo *) + try%lwt + (* fooooooooooo *) + let a = 3 in + Lwt.return a + with + | _ -> assert false +;; + +let%lwt f = function + | _ -> () +;; + +type%any_extension t = < a : 'a > + +let value = + f + [%any_extension + function + | 0 -> false + | _ -> true] +;; + +let value = [%any_extension fun x -> y] x + +let value = + f + [%any_extension + try x with + | x -> false + | _ -> true] +;; + +let value = + f + [%any_extension + match x with + | x -> false + | _ -> true] +;; + +let foo = + [%foooooooooo + fooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] +[@@foooooooooo + fooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] +;; + +[%%foooooooooo: + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[@@@foooooooooo + fooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +let _ = + [%ext + let+ a = b in + c] +;; + +let _ = + [%ext + "foo"; + "bar"] +;; + +let this_function_has_a_long_name plus very many arguments = "and a kind of long body" + +[%%expect {||}];; + +[%expect + {| +___________________________________________________________ +|}] + +[%%expect + {| +___________________________________________________________ +|}] + +let () = + (* -1 *) + [%(* 0 *) + (* 0.5 *) + test + () (* 1 *) [@foo (* 2 *) "bar"] (* 3 *)] +;; + +open%ext M + +[%%ext open M] + +open! %ext M + +[%%ext open! M] + +include%ext M + +[%%ext include M] + +let x = + let open%ext M in + x +;; + +let x = + [%ext + let open M in + x] +;; + +let x = + let open! %ext M in + x +;; + +let x = + [%ext + let open! M in + x] +;; + +exception%ext E + +[%%ext exception E] + +let _ = + let exception%ext E in + x +;; + +let _ = + [%ext + let exception E in + x] +;; + +module%ext E = P + +[%%ext module E = P] + +module%ext rec K = A +and L = A + +[%%ext + module rec K = A + and L = A] + +let _ = + let module%ext E = P in + x +;; + +let _ = + [%ext + let module E = P in + x] +;; + +module type%ext E = P + +[%%ext module type E = P] + +class%ext x = y + +[%%ext class x = y] + +class%ext x = y + +and y = z + +[%%ext + class x = y + + and y = z] + +class type%ext x = y + +[%%ext class type x = y] + +class type%ext x = y + +and y = z + +[%%ext + class type x = y + + and y = z] + +let _ = (* bar *) [%expr (* comment *) foo (* blabla *)] +let _ = assert%lwt false +let _ = [%lwt assert false] +let _ = f (assert%lwt false) +let _ = f [%lwt assert false] +let _ = (assert%lwt false) [@attr] +let _ = [%lwt assert false] [@attr] +let _ = f ((assert%lwt false) [@attr]) +let _ = f ([%lwt assert false] [@attr]) +let _ = lazy%ext e +let _ = [%ext lazy e] +let _ = f (lazy%ext e) +let _ = f [%ext lazy e] +let _ = (lazy%ext e) [@attr] +let _ = [%ext lazy e] [@attr] +let _ = f ((lazy%ext e) [@attr]) +let _ = f ([%ext lazy e] [@attr]) + +let _ = + object%ext + method x = y + end +;; + +let _ = + [%ext + object + method x = y + end] +;; + +let _ = + f + (object%ext + method x = y + end) +;; + +let _ = + f + [%ext + object + method x = y + end] +;; + +let _ = + (object%ext + method x = y + end) + [@attr] +;; + +let _ = + [%ext + object + method x = y + end] + [@attr] +;; + +let _ = + f + ((object%ext + method x = y + end) + [@attr]) +;; + +let _ = + f + ([%ext + object + method x = y + end] + [@attr]) +;; + +let _ = if%ext x then y else z +let _ = [%ext if x then y else z] +let _ = f (if%ext x then y else z) +let _ = f [%ext if x then y else z] +let _ = (if%ext x then y else z) [@attr] +let _ = [%ext if x then y else z] [@attr] +let _ = f ((if%ext x then y else z) [@attr]) +let _ = f ([%ext if x then y else z] [@attr]) + +let _ = + match%ext x with + | _ -> x +;; + +let _ = + [%ext + match x with + | _ -> x] +;; + +let _ = + f + (match%ext x with + | _ -> x) +;; + +let _ = + f + [%ext + match x with + | _ -> x] +;; + +let _ = + (match%ext x with + | _ -> x) + [@attr] +;; + +let _ = + [%ext + match x with + | _ -> x] + [@attr] +;; + +let _ = + f + ((match%ext x with + | _ -> x) + [@attr]) +;; + +let _ = + f + ([%ext + match x with + | _ -> x] + [@attr]) +;; + +let _ = + try%ext x with + | _ -> x +;; + +let _ = + [%ext + try x with + | _ -> x] +;; + +let _ = + f + (try%ext x with + | _ -> x) +;; + +let _ = + f + [%ext + try x with + | _ -> x] +;; + +let _ = + (try%ext x with + | _ -> x) + [@attr] +;; + +let _ = + [%ext + try x with + | _ -> x] + [@attr] +;; + +let _ = + f + ((try%ext x with + | _ -> x) + [@attr]) +;; + +let _ = + f + ([%ext + try x with + | _ -> x] + [@attr]) +;; + +let _ = fun%ext x -> x +let _ = [%ext fun x -> x] +let _ = f (fun%ext x -> x) +let _ = f [%ext fun x -> x] +let _ = (fun%ext x -> x) [@attr] +let _ = [%ext fun x -> x] [@attr] +let _ = f ((fun%ext x -> x) [@attr]) +let _ = f ([%ext fun x -> x] [@attr]) + +let _ = + function%ext + | x -> x +;; + +let _ = + [%ext + function + | x -> x] +;; + +let _ = + f + (function%ext + | x -> x) +;; + +let _ = + f + [%ext + function + | x -> x] +;; + +let _ = + (function%ext + | x -> x) + [@attr] +;; + +let _ = + [%ext + function + | x -> x] + [@attr] +;; + +let _ = + f + ((function%ext + | x -> x) + [@attr]) +;; + +let _ = + f + ([%ext + function + | x -> x] + [@attr]) +;; + +let _ = new%ext x +let _ = [%ext new x] +let _ = f (new%ext x) +let _ = f [%ext new x] +let _ = (new%ext x) [@attr] +let _ = [%ext new x] [@attr] +let _ = f ((new%ext x) [@attr]) +let _ = f ([%ext new x] [@attr]) + +let _ = + x;%ext + y +;; + +let _ = + [%ext + x; + y] +;; + +let _ = + f + (x;%ext + y) +;; + +let _ = + f + [%ext + x; + y] +;; + +let _ = + (x;%ext + y) + [@attr] +;; + +let _ = + [%ext + x; + y] + [@attr] +;; + +let _ = + f + ((x;%ext + y) + [@attr]) +;; + +let _ = + f + ([%ext + x; + y] + [@attr]) +;; diff --git a/test/passing/refs.janestreet/extensions.mli.ref b/test/passing/refs.janestreet/extensions.mli.ref new file mode 100644 index 0000000000..3e83162742 --- /dev/null +++ b/test/passing/refs.janestreet/extensions.mli.ref @@ -0,0 +1,96 @@ +type%foo t = < .. > + +type t = + [%foooooooooo + fooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] +[@@foooooooooo + fooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%foooooooooo + fooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%foooooooooo: + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[@@@foooooooooo + fooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%ext + val foooooooooooooooooooooo : fooooooooooo + val fooooooooooooooooooooooooooo : fooooo] + +exception%ext E + +[%%ext exception E] + +include%ext M + +[%%ext include M] + +module type%ext T = M + +[%%ext module type T = M] + +module%ext T : M + +[%%ext: module T : M] + +module%ext rec T : M +and Z : Q + +[%%ext: + module rec T : M + and Z : Q] + +module%ext T := M + +[%%ext: module T := M] + +open%ext M +open! %ext M + +[%%ext open M] +[%%ext open! M] + +type%foo t += T + +[%%foo: type t += T] + +val%foo x : t + +[%%foo: val x : t] + +external%foo x : t = "" + +[%%foo: external x : t = ""] + +class%foo x : t + +[%%foo: class x : t] + +class type%foo x = x + +[%%foo: class type x = x] + +type%ext t := x + +[%%ext: type t := x] diff --git a/test/passing/refs.janestreet/extensions_exp_grouping.ml.ref b/test/passing/refs.janestreet/extensions_exp_grouping.ml.ref new file mode 100644 index 0000000000..23a7607f8c --- /dev/null +++ b/test/passing/refs.janestreet/extensions_exp_grouping.ml.ref @@ -0,0 +1,102 @@ +let _ = + begin%ext + y >>= z + end +;; + +let _ = + [%ext + begin + y >>= z + end] +;; + +let _ = + x + >>= begin%ext + y >>= z + end +;; + +let _ = + x + >>= [%ext + begin + y >>= z + end] +;; + +let _ = + f + begin%ext + y >>= z + end +;; + +let _ = + f + [%ext + begin + y >>= z + end] +;; + +let _ = (module%ext S) +let _ = [%ext (module S)] +let _ = f (module%ext S) +let _ = f [%ext (module S)] +let _ = (module%ext S : S) +let _ = [%ext (module S : S)] +let _ = f (module%ext S : S) +let _ = f [%ext (module S : S)] + +let _ = + x;%ext + y +;; + +let _ = + [%ext + x; + y] +;; + +let _ = + f + (x;%ext + y) +;; + +let _ = + f + [%ext + x; + y] +;; + +let _ = + match w with + | (lazy%ext x) when x = y -> k + | [%ext lazy x] when x = y -> k + | (module%ext M) -> k + | [%ext (module M)] -> k + | (module%ext M : S) -> k + | [%ext (module M : S)] -> k + | (exception%ext e) -> k + | ((exception%ext e) [@attr]) -> k + | [%ext? exception e] -> k + | _ -> default +;; + +let a = + (* test *) + Lwt.return ();%lwt + Lwt.return 1 +;; + +let a = + f + ((* test *) + Lwt.return ();%lwt + Lwt.return 1) +;; diff --git a/test/passing/refs.janestreet/field-op_begin_line.ml.ref b/test/passing/refs.janestreet/field-op_begin_line.ml.ref new file mode 100644 index 0000000000..d1ca24deb3 --- /dev/null +++ b/test/passing/refs.janestreet/field-op_begin_line.ml.ref @@ -0,0 +1,21 @@ +let foo = + entry.logdata.value_end <- entry.logdata.value_end - !remove_size + testtesttest; + entry.logdata.value_end + <- (entry.logdata.value_end - !remove_size + testtesttest) [@foo]; + (* foooooooooo *) + entry.logdata.value_end + <- (entry.logdata.value_end - !remove_size + testtesttest) [@foo] + (* foooooooooooo *); + entry.logdata.value_end <- entry.logdata.value_end - !remove_size + testtesttest + (* fooooooooooooooooooooooooo *); + value_end <- entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest; + value_end + <- (entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest) [@foo]; + value_end + <- (entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest) [@foo] + (* fooooooooooooo *); + (* foooooooooooooooooooo *) + value_end <- entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest + (* foooooooo *); + foo +;; diff --git a/test/passing/refs.janestreet/field.ml.ref b/test/passing/refs.janestreet/field.ml.ref new file mode 100644 index 0000000000..d1ca24deb3 --- /dev/null +++ b/test/passing/refs.janestreet/field.ml.ref @@ -0,0 +1,21 @@ +let foo = + entry.logdata.value_end <- entry.logdata.value_end - !remove_size + testtesttest; + entry.logdata.value_end + <- (entry.logdata.value_end - !remove_size + testtesttest) [@foo]; + (* foooooooooo *) + entry.logdata.value_end + <- (entry.logdata.value_end - !remove_size + testtesttest) [@foo] + (* foooooooooooo *); + entry.logdata.value_end <- entry.logdata.value_end - !remove_size + testtesttest + (* fooooooooooooooooooooooooo *); + value_end <- entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest; + value_end + <- (entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest) [@foo]; + value_end + <- (entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest) [@foo] + (* fooooooooooooo *); + (* foooooooooooooooooooo *) + value_end <- entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest + (* foooooooo *); + foo +;; diff --git a/test/passing/refs.janestreet/first_class_module.ml.ref b/test/passing/refs.janestreet/first_class_module.ml.ref new file mode 100644 index 0000000000..dcc00fe71a --- /dev/null +++ b/test/passing/refs.janestreet/first_class_module.ml.ref @@ -0,0 +1,125 @@ +module type S = sig end + +type t = (module S) + +module type S = sig + val x : int +end + +module M = struct + let x = 0 +end + +let m = (module M : S) + +let () = + let (module M : S) = m in + (* error here *) + () +;; + +module type S = sig + val x : int +end + +module M = struct + let x = 0 +end + +let m = (module M : S) + +let f ((module M : S) as u) = + ignore u; + M.x +;; + +let f (T { m = (module M) }) = + ignore u; + M.x +;; + +let f (T { m = (module M : S) }) = + ignore u; + M.x +;; + +let v = f (module M : S with type t = t) + +module type S = sig + type a + + val va : a + + type b + + val vb : b +end + +let f (module M : S with type a = int and type b = int) = M.va + M.vb + +let f + (module M : S with type a = int and type b = int) + (module N : SSSS + with type a = int + and type b = int + and type c = int + and type d = int + and type e = int) + (module N : SSSS + with type a = int + and type b = int + and type c = int + and type d = int) + (module O : S with type a = int and type b = int and type c = int) + = + M.va + N.vb +;; + +module type M = sig + val storage : (module S with type t = t) +end + +let _ = + let module M = (val m : M) in + () +;; + +let _ = + (module Ephemeron (HHHHHHHHHHHHHHHHHHHHHHHHHH) (HHHHHHHHHHHHHHHHHHHHHHHHHH) + : Ephemeron.S) +;; + +let _ = (module Ephemeron (HHHHHHHHHHHHHHHHHHHHHHHHHH) (HHHHHHHHHHHHHHHHHH) : Ephemeron.S) +let _ = (module Ephemeron (HHHHHHHHHHHHHHH) (HHHHHHHHHHHHH) : Ephemeron.S) +let _ = (module Ephemeron (HHH) : Ephemeron.S) + +let _ = + (module Ephemeron (struct + type t = t + end) : Ephemeron.S) +;; + +let _ = + (module struct + let a = b + end) +;; + +(* Tests for dropped comment *) + +module M = (val x : S (* a *)) +module M = (val x (* b *)) + +[@@@ocamlformat "break-struct=natural"] + +let _ = (module struct let x = 0 let y = 1 end) + +(* Three form that have an equivalent AST: *) +let x : (module S) = (module M) +let x = (module M : S) +let x = (module M : S) + +(* Unpack containing a [pexp_constraint]. *) +module T = (val (x : (module S))) + +let _ = (module Int : T[@foo]) diff --git a/test/passing/refs.janestreet/floating_doc.ml.ref b/test/passing/refs.janestreet/floating_doc.ml.ref new file mode 100644 index 0000000000..64257a1e80 --- /dev/null +++ b/test/passing/refs.janestreet/floating_doc.ml.ref @@ -0,0 +1,11 @@ +type t = int + +(** Floating doc comment *) + +and u = float + +let f = () + +(** pesky doc comment *) + +and g = () diff --git a/test/passing/refs.janestreet/for_while.ml.ref b/test/passing/refs.janestreet/for_while.ml.ref new file mode 100644 index 0000000000..56798e08b9 --- /dev/null +++ b/test/passing/refs.janestreet/for_while.ml.ref @@ -0,0 +1,55 @@ +let () = + foo + (for i = 1 to 10 do + () + done) +;; + +let () = + foo + (while true do + () + done) +;; + +let _ = + for i = some expr to 1000 do + test this + done +;; + +let _ = + for + something_big = some big expression to something biggggggggggggggggggggggggggggggg + do + test this + done +;; + +let _ = + for + something_big = some big expressionnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn + to something + biggggggggggggggggggggggggggggggg + alsooooooooooooooooooooooooooooooooooooooooooo + do + test this + done +;; + +let _ = + for + something_big = some big expressionnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn + downto something + biggggggggggggggggggggggggggggggg + alsooooooooooooooooooooooooooooooooooooooooooo + do + test this + done +;; + +let _ = + while some bigggggggggggggggggggggg expressionnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn do + test this + done +;; diff --git a/test/passing/refs.janestreet/fun_decl-no-wrap-fun-args.ml.ref b/test/passing/refs.janestreet/fun_decl-no-wrap-fun-args.ml.ref new file mode 100644 index 0000000000..7a73631dc8 --- /dev/null +++ b/test/passing/refs.janestreet/fun_decl-no-wrap-fun-args.ml.ref @@ -0,0 +1,122 @@ +let _ = fun (x : int) : int -> some_large_computation +let _ = fun (x : int) : int -> (some_large_computation : int) +let fooo = List.foooo ~f:(fun foooo foooo : bool -> foooooooooooooooooooooo) + +let _ = + fun (x : int) + (x : int) + (x : int) + (x : int) + (x : int) + : fooooooooooooooooooooooooooo foooooooooooooo foooooooooo -> + some_large_computation +;; + +let _ = + fun (x : int) + (x : int) + (x : int) + (x : int) + (x : int) + (x : int) + (x : int) + : fooooooooooooooooooooooooooo foooooooooooooo foooooooooo -> + some_large_computation +;; + +let () = + fun x : int -> + fun r : int -> + fun u -> + foooooooooooooooooooooooooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +let to_loc_trace + ?(desc_of_source = + fun source -> + let callsite = Source.call_site source in + Format.asprintf "return from %a" Typ.Procname.pp (CallSite.pname callsite)) + ?(source_should_nest = fun _ -> true) + ?(desc_of_sink = + fun sink -> + let callsite = Sink.call_site sink in + Format.asprintf "call to %a" Typ.Procname.pp (CallSite.pname callsite)) + ?(sink_should_nest = fun _ -> true) + (passthroughs, sources, sinks) + = + () +;; + +let translate_captured + { Clang_ast_t.lci_captured_var + ; lci_init_captured_vardecl + ; lci_capture_this + ; lci_capture_kind + } + ((trans_results_acc, captured_vars_acc) as acc) + = + () +;; + +let f ssssssssss = + String.fold ssssssssss ~init:innnnnnnnnnit ~f:(fun accuuuuuuuuuum -> function + | '0' -> g accuuuuuuuuuum + | '1' -> h accuuuuuuuuuum + | _ -> i accuuuuuuuuuum) +;; + +let f ssssssssss = + String.fold ssssssssss ~init:innnnnnnnnnit ~f:(function + | '0' -> g accuuuuuuuuuum + | '1' -> h accuuuuuuuuuum + | _ -> i accuuuuuuuuuum) +;; + +let f _ = + let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in + fun x -> + let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in + x +;; + +let f _ = + let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in + (* foo *) + fun x -> + let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in + x +;; + +let space_break = + (* a stack is useless here, this would require adding a unit parameter *) + with_pp (fun fs -> + Box_debug.space_break fs; + Format_.pp_print_space fs ()) +;; + +let _ = + (fun k -> + let _ = 42 in + ()) + @@ () +;; + +let _ = + let _ = () in + fun (context : Context.t) + ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t) -> + let _ = () in + () +;; + +class traverse_labels h = + object + method statement = + function + | Labelled_statement (L l, (s, _)) -> + let m = {<ldepth = ldepth + 1>} in + Hashtbl.add h l ldepth; + m#statement s + | s -> super#statement s + end diff --git a/test/passing/refs.janestreet/fun_decl.ml.ref b/test/passing/refs.janestreet/fun_decl.ml.ref new file mode 100644 index 0000000000..7a73631dc8 --- /dev/null +++ b/test/passing/refs.janestreet/fun_decl.ml.ref @@ -0,0 +1,122 @@ +let _ = fun (x : int) : int -> some_large_computation +let _ = fun (x : int) : int -> (some_large_computation : int) +let fooo = List.foooo ~f:(fun foooo foooo : bool -> foooooooooooooooooooooo) + +let _ = + fun (x : int) + (x : int) + (x : int) + (x : int) + (x : int) + : fooooooooooooooooooooooooooo foooooooooooooo foooooooooo -> + some_large_computation +;; + +let _ = + fun (x : int) + (x : int) + (x : int) + (x : int) + (x : int) + (x : int) + (x : int) + : fooooooooooooooooooooooooooo foooooooooooooo foooooooooo -> + some_large_computation +;; + +let () = + fun x : int -> + fun r : int -> + fun u -> + foooooooooooooooooooooooooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +let to_loc_trace + ?(desc_of_source = + fun source -> + let callsite = Source.call_site source in + Format.asprintf "return from %a" Typ.Procname.pp (CallSite.pname callsite)) + ?(source_should_nest = fun _ -> true) + ?(desc_of_sink = + fun sink -> + let callsite = Sink.call_site sink in + Format.asprintf "call to %a" Typ.Procname.pp (CallSite.pname callsite)) + ?(sink_should_nest = fun _ -> true) + (passthroughs, sources, sinks) + = + () +;; + +let translate_captured + { Clang_ast_t.lci_captured_var + ; lci_init_captured_vardecl + ; lci_capture_this + ; lci_capture_kind + } + ((trans_results_acc, captured_vars_acc) as acc) + = + () +;; + +let f ssssssssss = + String.fold ssssssssss ~init:innnnnnnnnnit ~f:(fun accuuuuuuuuuum -> function + | '0' -> g accuuuuuuuuuum + | '1' -> h accuuuuuuuuuum + | _ -> i accuuuuuuuuuum) +;; + +let f ssssssssss = + String.fold ssssssssss ~init:innnnnnnnnnit ~f:(function + | '0' -> g accuuuuuuuuuum + | '1' -> h accuuuuuuuuuum + | _ -> i accuuuuuuuuuum) +;; + +let f _ = + let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in + fun x -> + let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in + x +;; + +let f _ = + let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in + (* foo *) + fun x -> + let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in + x +;; + +let space_break = + (* a stack is useless here, this would require adding a unit parameter *) + with_pp (fun fs -> + Box_debug.space_break fs; + Format_.pp_print_space fs ()) +;; + +let _ = + (fun k -> + let _ = 42 in + ()) + @@ () +;; + +let _ = + let _ = () in + fun (context : Context.t) + ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t) -> + let _ = () in + () +;; + +class traverse_labels h = + object + method statement = + function + | Labelled_statement (L l, (s, _)) -> + let m = {<ldepth = ldepth + 1>} in + Hashtbl.add h l ldepth; + m#statement s + | s -> super#statement s + end diff --git a/test/passing/refs.janestreet/fun_function.ml.ref b/test/passing/refs.janestreet/fun_function.ml.ref new file mode 100644 index 0000000000..19a81ba613 --- /dev/null +++ b/test/passing/refs.janestreet/fun_function.ml.ref @@ -0,0 +1,192 @@ +let s = + List.fold x ~f:(fun y -> function + | Aconstructor avalue -> afunction avalue + | Bconstructor bvalue -> bfunction bvalue) +;; + +let f _ = + (function + | x -> x + 1) +;; + +let f _ = function + | x -> x + 1 +;; + +let f _ = + fun _ -> + (function + | x -> x + 1) +;; + +let f _ = + fun _ -> function + | x -> x + 1 +;; + +let f _ = + fun _ -> + (function + | x -> x + 1) +;; + +let f _ = + fun _ -> function + | x -> x + 1 +;; + +let f _ = fun _ -> fun x -> x + 1 +let f _ = fun _ -> fun x -> x + 1 +let f _ = fun _ -> fun x -> x + 1 +let f _ = fun _ -> fun x -> x + 1 + +let _ = + let f _ = + (function + | x -> x + 1) + in + () +;; + +let _ = + let f _ = function + | x -> x + 1 + in + () +;; + +let _ = + let f _ = + fun _ -> + (function + | x -> x + 1) + in + () +;; + +let _ = + let f _ = + fun _ -> function + | x -> x + 1 + in + () +;; + +let _ = + let f _ = + fun _ -> + (function + | x -> x + 1) + in + () +;; + +let _ = + let f _ = + fun _ -> function + | x -> x + 1 + in + () +;; + +let _ = + let f _ = fun _ -> fun x -> x + 1 in + () +;; + +let _ = + let f _ = fun _ -> fun x -> x + 1 in + () +;; + +let _ = + let f _ = fun _ -> fun x -> x + 1 in + () +;; + +let _ = + let f _ = fun _ -> fun x -> x + 1 in + () +;; + +class c = + let f _ = + (function + | x -> x + 1) + in + object end + +class c = + let f _ = function + | x -> x + 1 + in + object end + +class c = + let f _ = + fun _ -> + (function + | x -> x + 1) + in + object end + +class c = + let f _ = + fun _ -> function + | x -> x + 1 + in + object end + +class c = + let f _ = + fun _ -> + (function + | x -> x + 1) + in + object end + +class c = + let f _ = + fun _ -> function + | x -> x + 1 + in + object end + +class c = + let f _ = fun _ -> fun x -> x + 1 in + object end + +class c = + let f _ = fun _ -> fun x -> x + 1 in + object end + +class c = + let f _ = fun _ -> fun x -> x + 1 in + object end + +class c = + let f _ = fun _ -> fun x -> x + 1 in + object end + +open struct + [@@@ocamlformat "let-binding-deindent-fun=true"] + + let _ = + let _ = function + | Partial _ -> + fun { target } -> + (match target with + | Lazy key -> Val_ref.of_key key + | Lazy_loaded { v_ref; _ } | Dirty { v_ref; _ } -> v_ref) + in + () + ;; + + let _ = function + | Partial _ -> + fun { target } -> + (match target with + | Lazy key -> Val_ref.of_key key + | Lazy_loaded { v_ref; _ } | Dirty { v_ref; _ } -> v_ref) + ;; +end diff --git a/test/passing/refs.janestreet/function_indent-never.ml.ref b/test/passing/refs.janestreet/function_indent-never.ml.ref new file mode 100644 index 0000000000..931a352117 --- /dev/null +++ b/test/passing/refs.janestreet/function_indent-never.ml.ref @@ -0,0 +1,51 @@ +let foooooooo = function + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo +;; + +let foooooooo = function + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo +;; + +let foo = + fooooooooo foooooooo ~foooooooo:(function + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo) +;; + +let foo = + fooooooooo foooooooo foooooooo foooooooo foooooooo foooooooo ~foooooooo:(function + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo) +;; + +let foooooooo = + if fooooooooooo + then + function + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + else + function + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo +;; + +let _ = + { foo = + (fun _ -> function + | _ -> + let _ = 42 in + () + | () -> ()) + } +;; + +let _ = + match () with + | _ -> + f + >>= (function + | `Fooooooooooooooooooooooooooooooooooooooo -> 1 + | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> 2) +;; diff --git a/test/passing/refs.janestreet/function_indent.ml.ref b/test/passing/refs.janestreet/function_indent.ml.ref new file mode 100644 index 0000000000..22fe67975a --- /dev/null +++ b/test/passing/refs.janestreet/function_indent.ml.ref @@ -0,0 +1,51 @@ +let foooooooo = function + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo +;; + +let foooooooo = function + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo +;; + +let foo = + fooooooooo foooooooo ~foooooooo:(function + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo) +;; + +let foo = + fooooooooo foooooooo foooooooo foooooooo foooooooo foooooooo ~foooooooo:(function + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo) +;; + +let foooooooo = + if fooooooooooo + then + function + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + else + function + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo +;; + +let _ = + { foo = + (fun _ -> function + | _ -> + let _ = 42 in + () + | () -> ()) + } +;; + +let _ = + match () with + | _ -> + f + >>= (function + | `Fooooooooooooooooooooooooooooooooooooooo -> 1 + | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> 2) +;; diff --git a/test/passing/refs.janestreet/functor.ml.ref b/test/passing/refs.janestreet/functor.ml.ref new file mode 100644 index 0000000000..362a254195 --- /dev/null +++ b/test/passing/refs.janestreet/functor.ml.ref @@ -0,0 +1,88 @@ +module type S = functor () -> sig end +module type S = functor () () -> sig end +module type M = functor () -> sig end +module type M = functor (S : S) -> sig end +module type M = functor (S : S) (T : T) -> sig end +module type M = functor (S : S) (T : T) -> U +module type M = functor (S : S) () -> sig end + +module type M = functor (SSSSS : SSSSSSSSSSSSSS) (TTTTT : TTTTTTTTTTTTTTTT) -> sig + val t1 : a + val t2 : b +end + +module M : functor () -> sig end = functor () -> struct end +module M = (functor (S : S) -> struct end) (S) +module M = (functor (S : S) (T : T) -> struct end) (S) (T) +module M = (functor (S : S) (T : T) -> struct end : U) (S) (T) +module M = (functor (S : S) () -> struct end : U) (S) (T) +module M = (functor (S : S) (T : T) -> (struct end : U)) (S) (T) +module rec A (S : S) = S + +module type S = sig + module rec A : functor (S : S) -> S +end + +module M = + (functor + (SSSSS : sssssSSSSSSSSSSSSSS) + (TTTTT : TTTTTTTTTTTTTTTTTTTTT) + -> + struct + let x = 2 + let y = 3 + end) + (S) + (T) + +module type Module_type_fail = sig + include S + module F : functor (_ : T) -> sig end + include S +end + +module type KV_MAKER = functor (G : Irmin_git.G) (C : Irmin.Contents.S) -> + S + with type key = string list + and type step = string + and type contents = C.t + and type branch = string + and module Git = G + +module Make + (TT : TableFormat.TABLES) + (IT : InspectionTableFormat.TABLES__________________________________________) + (ET : + EngineTypes.TABLE + with type terminal = int + and type nonterminal = int + and type semantic_value = Obj.t) + (E : sig + type 'a env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env + end) = +struct + type t = t +end + +module Make + (TT : TableFormat.TABLES) + (IT : InspectionTableFormat.TABLES__________________________________________) = +struct + type t = t +end + +(* Long syntax should be preserved *) +module M = functor (_ : S) -> struct end +module M (_ : S) = struct end +module M : functor (_ : S) -> S' = functor (_ : S) -> struct end + +module type SETFUNCTOR = (Elt : ORDERED_TYPE) -> sig end + +module WrongSet : (Elt : ORDERED_TYPE) -> SET = Set +module M : (A : S) (B : S) -> S = N +module M : (A : S) (B : S) -> S = N +module M : functor (A : S) -> (B : S) -> S = N +module M : functor (A : S) (B : S) -> S = N +module M : functor (A : S) (B : S) -> S = N +module M : functor (A : S) (B : S) -> S = N +module M : (A : S) -> functor (B : S) -> S = N diff --git a/test/passing/refs.janestreet/functor.mli.ref b/test/passing/refs.janestreet/functor.mli.ref new file mode 100644 index 0000000000..069e1d89c9 --- /dev/null +++ b/test/passing/refs.janestreet/functor.mli.ref @@ -0,0 +1,3 @@ +module F (* test *) (M : sig + type t + end) : S diff --git a/test/passing/refs.janestreet/funsig.ml.ref b/test/passing/refs.janestreet/funsig.ml.ref new file mode 100644 index 0000000000..07d3b89064 --- /dev/null +++ b/test/passing/refs.janestreet/funsig.ml.ref @@ -0,0 +1,69 @@ +val fffffffff : aaaaaa -> bbbbbbbbbb ccccccccc -> dddd +val fffffffff : aaaaaa -> bbbbbbbbbb ccccccccc -> dddd -> dddd -> dddd -> dddd +val fffffffff : aaaaaa -> (bbbbbbbbbb ccccccccc -> int) -> bbbbbbbbbb ccccccccc -> dddd + +val fffffffff + : eeee:('a, 'b) aaaaaa + -> (bbbbbbbbbb ccccccccc -> int) + -> bbbbbbbbbb ccccccccc + -> dddd + -> dddd + +val m : (module S with type t = t) + +val f + : ( 'aaaaaaaaaaaaaaaaaaaa + , xxxxxxxxxxxxxxxxxxxxxxxxx -> yyyyyyyyyyyyyyyyyyyyyyyyy -> bbbbbbbbbbbbbbbbbbbb + , 'dddddddddddddddddddd ) + s + +type t = + | Cstr of + (xxxxxxxxxxxxxxxxxxxxxxxxx -> yyyyyyyyyyyyyyyyyyyyyyyyy -> aaaaaaaaaaaaaaaaaaaa) + * bbbbbbbbbbbbbbbbbbbb + +type t = + | Cstr of + aaaaaaaaaaaaaaaaaaaa + * (xxxxxxxxxxxxxxxxxxxxxxxxx -> yyyyyyyyyyyyyyyyyyyyyyyyy -> bbbbbbbbbbbbbbbbbbbb) + * cccccccccccccccccccc + +type ('aaaa, 'bbbb, 'cccc) t = + llll:('aaaa, 'bbbb, 'cccc) s -> dddddd list -> 'aaaa * 'cccc -> 'bbbb uuuuu + +external ident : a -> b -> c -> d = "something" +external ident : a -> b -> c -> d = "something" "else" +val ident : a -> b -> c -> d +val ident : arg1_is_loooooooooooooooooooooooooooooooong -> arg2 -> arg3 -> arg4 + +external ident + : arg1_is_loooooooooooooooooooooooooooooooong + -> arg2 + -> arg3 + -> arg4 + = "something" "else" + +type t = + { field1 : a -> b -> c + ; field2 : int + ; field3 : a -> b -> c -> d -> e + } + +type t = + { field1 : a -> b -> c + ; field2 : int + ; field3 : a -> b -> c -> d -> e -> f + } + +type t = + { field1 : a -> b -> c + ; field2 : int + ; field3 : + a_is_loooooooooooooooooooooooooooooooong + -> b_is_loooooooooooooooooooooooooooooooong + -> c + -> d + -> e + ; field4 : a_is_loooooooooooooooooooong -> b_is_loooooooooong -> c -> d -> e + ; field5 : a loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong typ + } diff --git a/test/passing/refs.janestreet/gadt.ml.ref b/test/passing/refs.janestreet/gadt.ml.ref new file mode 100644 index 0000000000..985617da15 --- /dev/null +++ b/test/passing/refs.janestreet/gadt.ml.ref @@ -0,0 +1,15 @@ +type t = A : t +type t = A : t * 'b -> t + +type (_, _, _, _, _) gadt = + | SomeLongName : + ('a, 'b, long_name * long_name2, 't, 'u) gadt * ('b, 'c, 'v, 'u, 'k) gadt2 + -> ('a, 'c, long_name * 'k, 't, 'v) gadt + | AnEvenLongerName : + ('a, 'b, long_name * long_name2, 't, 'u) gadt * ('b, 'c, 'v, 'u, 'k) gadt2 + -> ('a, 'c, long_name * 'k, 't, 'v) gadt + +type _ t = .. +type _ t += A : int | B : int -> int +type t = A : (int -> int) -> int +type _ g = MkG : 'a. 'a g diff --git a/test/passing/refs.janestreet/generative.ml.ref b/test/passing/refs.janestreet/generative.ml.ref new file mode 100644 index 0000000000..676a0bda6b --- /dev/null +++ b/test/passing/refs.janestreet/generative.ml.ref @@ -0,0 +1,9 @@ +module Generative () = struct end +module M = Generative () +module M = String_id (M) () +module F2 : functor () -> sig end = F1 +module F2 : functor () () -> sig end = F1 +module F2 : (*xx*) ( (*yy*) ) (*zz*) -> sig end = F1 +module F2 : () -> functor [@attr] () () -> sig end = F1 +module F2 : () -> functor () () -> () -> sig end = F1 +module F2 : () () () -> functor () () -> () -> sig end = F1 diff --git a/test/passing/refs.janestreet/hash_bang.ml.ref b/test/passing/refs.janestreet/hash_bang.ml.ref new file mode 100644 index 0000000000..c5284310b4 --- /dev/null +++ b/test/passing/refs.janestreet/hash_bang.ml.ref @@ -0,0 +1,3 @@ +#!/usr/bin/env ocaml + +let _ = sprintf "[%s]" s diff --git a/test/passing/refs.janestreet/hash_types.ml.ref b/test/passing/refs.janestreet/hash_types.ml.ref new file mode 100644 index 0000000000..1c4815c17f --- /dev/null +++ b/test/passing/refs.janestreet/hash_types.ml.ref @@ -0,0 +1,13 @@ +module F (X : sig + type t + end) = +struct + class type ['a] c = object + method m : 'a -> X.t + end +end + +class ['a] c = + object + constraint 'a = 'a #F(Int).c + end diff --git a/test/passing/tests/holes.ml.ref b/test/passing/refs.janestreet/holes.ml.ref similarity index 100% rename from test/passing/tests/holes.ml.ref rename to test/passing/refs.janestreet/holes.ml.ref diff --git a/test/passing/tests/ifand.ml.ref b/test/passing/refs.janestreet/ifand.ml.ref similarity index 97% rename from test/passing/tests/ifand.ml.ref rename to test/passing/refs.janestreet/ifand.ml.ref index 7e7d222604..e384fc0fff 100644 --- a/test/passing/tests/ifand.ml.ref +++ b/test/passing/refs.janestreet/ifand.ml.ref @@ -2,3 +2,4 @@ let _ = if cond1 && cond2 then _ let _ = function | _ when x = 2 && y = 3 -> if a = b || (b = c && c = d) then _ +;; diff --git a/test/passing/refs.janestreet/index_op.ml.ref b/test/passing/refs.janestreet/index_op.ml.ref new file mode 100644 index 0000000000..c43640e838 --- /dev/null +++ b/test/passing/refs.janestreet/index_op.ml.ref @@ -0,0 +1,159 @@ +let ( .?[] ) = Hashtbl.find_opt +let ( .@[] ) = Hashtbl.find +let ( .@[]<- ) = Hashtbl.add +let ( .@{} ) = Hashtbl.find +let ( .@{}<- ) = Hashtbl.add +let ( .@() ) = Hashtbl.find +let ( .@()<- ) = Hashtbl.add +let h = Hashtbl.create 17;; + +h.@("One") <- 1; +assert (h.@{"One"} = 1); +print_int h.@{"One"}; +assert (h.?["Two"] = None) + +(* from GPR#1392 *) +let ( #? ) x y = x, y +let ( .%() ) x y = x.(y) +let x = [| 0 |] +let _ = 1#?x.(0) +let _ = 1#?x.%(0);; + +a.[b].[c];; +a.[b.[c]].[c];; +a.b.c + +let _ = s.{1} +let _ = s.{1} <- 1 +let _ = s.{1, 2} +let _ = s.{1, 2} <- 1 +let _ = s.{1, 2, 3} +let _ = s.{1, 2, 3} <- 1 +let _ = s.{1, 2, 3, 4} +let _ = s.{1, 2, 3, 4} <- 1 +let _ = Bigarray.Genarray.get s 1 [||] +let _ = Bigarray.Genarray.get s [| 1 |] +let _ = Bigarray.Genarray.get s [| 1; 2 |] +let _ = Bigarray.Genarray.get s [| 1; 2; 3 |] +let _ = s.{1, 2, 3, 4} +let _ = Bigarray.Genarray.set s [||] 1 +let _ = Bigarray.Genarray.set s [| 1 |] 1 +let _ = Bigarray.Genarray.set s [| 1; 2 |] 1 +let _ = Bigarray.Genarray.set s [| 1; 2; 3 |] 1 +let _ = s.{1, 2, 3, 4} <- 1 + +let () = + let m = Mat.zeros 5 5 in + m.Mat.${[ [ 2 ]; [ 5 ] ]} |> ignore; + let open Mat in + m.${[ [ 2 ]; [ 5 ] ]} |> ignore +;; + +let _ = (x.*{y, z} <- w) @ [] +let _ = (x.{y, z} <- w) @ [] +let _ = (x.*(y) <- z) @ [] +let _ = (x.*(y) <- z) := [] +let _ = (x.*(y) <- z), [] + +let _ = + x.*(y) <- z; + [] +;; + +let _ = (x.(y) <- z) @ [] +let _ = (x.(y) <- z) := [] +let _ = (x.(y) <- z), [] + +let _ = + x.(y) <- z; + [] +;; + +let _ = (x.y <- z) @ [] +let _ = (x.y <- z) := [] +let _ = (x.y <- z), [] + +let _ = + x.y <- z; + [] +;; + +let _ = x.(y) <- (z.(w) <- u) +let _ = x.foo#m + +class free = + object (m : 'test) + method get_def = m#state.def + end + +(* With path *) +let _ = + a.A.B.*(b); + a.A.B.*(b) <- c +;; + +let _ = + a.*((a; + b)) +;; + +let _ = a.*([| a; b |]) + +(* Avoid unecessary parentheses *) +let _ = + match a with + | A -> + a.*(match b with + | B -> b) + | B -> + a.*(match b with + | B -> b) <- D + | C -> () +;; + +let _ = if a then a.*(if a then b) else c + +(* Parentheses needed *) +let _ = + a.*{(a; + b)} +;; + +let _ = + a.{a; + b} +;; + +let _ = a.{a, b} + +(* Integers on the left of indexing operators must be surrounded by + parentheses *) +let _ = (0).*(0) + +(* Integers with suffix and floats are fine *) +let _ = 0l.*(0) +let _ = 0..*(0) +let _ = 0.2.*(0) +let _ = 2e5.*(0) +let _ = 2e-2.*(0) +let _ = (String.get [@bar]) filename (len - 1) = 'i' +let _ = "hello world".[-8] +let _ = String.get "hello world" (-8) +let _ = String.unsafe_get "hello world" (-8) +let _ = [||].(-8) +let _ = Array.get [||] (-8) +let _ = Array.unsafe_get [||] (-8) +let _ = Bigarray.Genarray.get x [||] (-8) +let _ = Bigarray.Genarray.unsafe_get x [||] (-8) +let _ = [%p (Some).(tickers)] +let _ = [%p (Explicit).(0 / 2)] +let _ = [%p Some.(tickers)] +let _ = [%p Explicit.(0 / 2)] +let _ = (Some).(tickers) +let _ = (Explicit).(0 / 2) +let _ = Some.(tickers) +let _ = Explicit.(0 / 2) +let _ = f (Some).(tickers) +let _ = f (Explicit).(0 / 2) +let _ = f Some.(tickers) +let _ = f Explicit.(0 / 2) diff --git a/test/passing/refs.janestreet/indicate_multiline_delimiters-cosl.ml.ref b/test/passing/refs.janestreet/indicate_multiline_delimiters-cosl.ml.ref new file mode 100644 index 0000000000..32be44c87f --- /dev/null +++ b/test/passing/refs.janestreet/indicate_multiline_delimiters-cosl.ml.ref @@ -0,0 +1,70 @@ +let compare = function + | Eq -> ( = ) + | Neq -> ( <> ) + | Lt -> ( < ) [@attr] + | Le -> ( <= ) + | Gt -> ( > ) + | Ge -> ( >= ) +;; + +let raise fmt = + Fmt.kstr + (fun error_message (result : _ result) -> + match result with + | Ok v -> v + | Error `Oh_no -> invalid_arg error_message + ) + fmt +;; + +let raise fmt = + Fmt.kstr + (fun error_message aaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb -> + invalid_arg error_message + ) + fmt +;; + +let raise fmt = + Fmt.kstr + (fun error_message (result : _ result) -> + match result with + | Ok v -> v + | Error `Oh_no -> invalid_arg error_message + ) + fmt +;; + +let raise fmt = + Fmt.kstr + (fun error_message aaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb -> + invalid_arg error_message + ) + fmt +;; + +let contrived = + List.map + ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + ) + l +;; + +let contrived = + List.map l ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + ) +;; + +let x = + match y with + | Empty | Leaf _ -> assert false + | Node + ( { left = lr_left; key = _; value = fooooooo; height = _; right = lr_right } as + lr_node + ) -> + left_node.right <- lr_left; + root_node.left <- lr_right; + lr_node.right <- tree +;; diff --git a/test/passing/refs.janestreet/indicate_multiline_delimiters-space.ml.ref b/test/passing/refs.janestreet/indicate_multiline_delimiters-space.ml.ref new file mode 100644 index 0000000000..adea387434 --- /dev/null +++ b/test/passing/refs.janestreet/indicate_multiline_delimiters-space.ml.ref @@ -0,0 +1,63 @@ +let compare = function + | Eq -> ( = ) + | Neq -> ( <> ) + | Lt -> ( < ) [@attr] + | Le -> ( <= ) + | Gt -> ( > ) + | Ge -> ( >= ) +;; + +let raise fmt = + Fmt.kstr + (fun error_message (result : _ result) -> + match result with + | Ok v -> v + | Error `Oh_no -> invalid_arg error_message ) + fmt +;; + +let raise fmt = + Fmt.kstr + (fun error_message aaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb -> + invalid_arg error_message ) + fmt +;; + +let raise fmt = + Fmt.kstr + (fun error_message (result : _ result) -> + match result with + | Ok v -> v + | Error `Oh_no -> invalid_arg error_message ) + fmt +;; + +let raise fmt = + Fmt.kstr + (fun error_message aaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb -> + invalid_arg error_message ) + fmt +;; + +let contrived = + List.map + ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa ) + l +;; + +let contrived = + List.map l ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa ) +;; + +let x = + match y with + | Empty | Leaf _ -> assert false + | Node + ( { left = lr_left; key = _; value = fooooooo; height = _; right = lr_right } as + lr_node ) -> + left_node.right <- lr_left; + root_node.left <- lr_right; + lr_node.right <- tree +;; diff --git a/test/passing/refs.janestreet/indicate_multiline_delimiters.ml.ref b/test/passing/refs.janestreet/indicate_multiline_delimiters.ml.ref new file mode 100644 index 0000000000..93850d508a --- /dev/null +++ b/test/passing/refs.janestreet/indicate_multiline_delimiters.ml.ref @@ -0,0 +1,63 @@ +let compare = function + | Eq -> ( = ) + | Neq -> ( <> ) + | Lt -> ( < ) [@attr] + | Le -> ( <= ) + | Gt -> ( > ) + | Ge -> ( >= ) +;; + +let raise fmt = + Fmt.kstr + (fun error_message (result : _ result) -> + match result with + | Ok v -> v + | Error `Oh_no -> invalid_arg error_message) + fmt +;; + +let raise fmt = + Fmt.kstr + (fun error_message aaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb -> + invalid_arg error_message) + fmt +;; + +let raise fmt = + Fmt.kstr + (fun error_message (result : _ result) -> + match result with + | Ok v -> v + | Error `Oh_no -> invalid_arg error_message) + fmt +;; + +let raise fmt = + Fmt.kstr + (fun error_message aaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb -> + invalid_arg error_message) + fmt +;; + +let contrived = + List.map + ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) + l +;; + +let contrived = + List.map l ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) +;; + +let x = + match y with + | Empty | Leaf _ -> assert false + | Node + ({ left = lr_left; key = _; value = fooooooo; height = _; right = lr_right } as + lr_node) -> + left_node.right <- lr_left; + root_node.left <- lr_right; + lr_node.right <- tree +;; diff --git a/test/passing/refs.janestreet/infix_arg_grouping.ml.ref b/test/passing/refs.janestreet/infix_arg_grouping.ml.ref new file mode 100644 index 0000000000..ac91611938 --- /dev/null +++ b/test/passing/refs.janestreet/infix_arg_grouping.ml.ref @@ -0,0 +1,175 @@ +vbox + 1 + (str (Sexp.to_string_hum (Itv.sexp_of_t root)) + $ wrap_if (not (List.is_empty children)) "@,{" " }" (dump_ tree children)) +;; + +user_error + ("version mismatch: .ocamlformat requested " + ^ value + ^ " but version is " + ^ Version.version) +;; + +hvbox + 1 + (str "\"" + $ list_pn lines (fun ?prev curr ?next -> + let drop = function + | ' ' -> true + | _ -> false + in + let line = if Option.is_none prev then curr else String.lstrip ~drop curr in + fmt_line line + $ opt next (fun next -> + let spc = + match String.lfindi next ~f:(fun _ c -> not (drop c)) with + | Some 0 -> "" + | Some i -> escape_string (String.sub next 0 i) + | None -> escape_string next + in + fmt "\\n" $ fmt_if_k (not (String.is_empty next)) (str spc $ pre_break 0 "\\" 0))) + $ str "\"" + $ Option.call ~f:epi) +;; + +hvbox + 0 + (wrap_fits_breaks + "<" + ">" + (list fields "@ ; " (function + | Otag (lab_loc, attrs, typ) -> + (* label loc * attributes * core_type -> object_field *) + let doc, atrs = doc_atrs attrs in + let fmt_cmts = Cmts.fmt c lab_loc.loc in + fmt_cmts + @@ hvbox + 4 + (hvbox + 2 + (Cmts.fmt c lab_loc.loc @@ str lab_loc.txt + $ fmt ":@ " + $ fmt_core_type c (sub_typ ~ctx typ)) + $ fmt_docstring c ~pro:(fmt "@;<2 0>") doc + $ fmt_attributes c (fmt " ") ~key:"@" atrs (fmt "")) + | Oinherit typ -> fmt_core_type c (sub_typ ~ctx typ)) + $ fmt_if + Poly.(closedness = Open) + (match fields with + | [] -> "@ .. " + | _ -> "@ ; .. "))) +;; + +hvbox + 0 + (fmt "functor@ " + $ wrap + "(" + ")" + (str txt + $ opt mt (fun _ -> + fmt "@ : " + $ Option.call ~f:pro_t + $ psp_t + $ fmt "@;<1 2>" + $ bdy_t + $ esp_t + $ Option.call ~f:epi_t)) + $ fmt " ->@ " + $ Option.call ~f:pro_e + $ psp_e + $ bdy_e + $ esp_e + $ Option.call ~f:epi_e) + +let to_json { integers; floats; strings } = + `Assoc + [ "int", yojson_of_integers integers + ; "double", yojson_of_floats floats + ; "normal", yojson_of_strings strings + ] + |> Yojson.Basic.to_string +;; + +let rename (us, q) sub = + ( Var.Set.union (Var.Set.diff us (Var.Subst.domain sub)) (Var.Subst.range sub) + , rename_q q sub ) + |> check invariant +;; + +let _ = + List.map + ~f + ([ aaaaaaaaaaaaaaa + ; bbbbbbbbbbbbbbb + ; ccccccccccccccc + ; ddddddddddddddd + ; eeeeeeeeeeeeeee + ] + @ l) +;; + +let sigma_seed = + create_seed_vars + ((* formals already there plus new ones *) + prop.Prop.sigma + @ sigma_new_formals) +;; + +match + "\"" ^ line ^ " \"" + |> + (* split by whitespace *) + Str.split (Str.regexp_string "\" \"") +with +| prog :: args -> fooooooooooooooooooooo + +let () = + (* Open the repo *) + initialise + >>= + (* Perform a subsequent action *) + subsequent_action + >|= + (* Keep going... *) + another_action + |> fun t -> + (* And finally do this *) + final_action t +;; + +let () = + (* Open the repo *) + initialise + (* Perform a subsequent action *) + >>= subsequent_action + (* Keep going... *) + >|= another_action + (* And finally do this *) + |> fun t -> final_action t +;; + +let _ = + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + - + (* ___________________________________ *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +;; + +let _ = + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + >= + (* ___________________________________ *) + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +;; + +let _ = + List.filter (fun s -> + (* 3.1. the sid of the authenticated user *) + foooooooooooooooooooooooooooooo + || + (* 3.2. any sids of the group that authenticated the user *) + (* TODO: better to look up the membership closure *) + fooooooooooooooooooooooooooo) +;; diff --git a/test/passing/refs.janestreet/infix_bind-break.ml.ref b/test/passing/refs.janestreet/infix_bind-break.ml.ref new file mode 100644 index 0000000000..42f75afea2 --- /dev/null +++ b/test/passing/refs.janestreet/infix_bind-break.ml.ref @@ -0,0 +1,324 @@ +f x +>>= fun y -> +g y +>>= fun () -> f x >>= fun y -> g y >>= fun () -> f x >>= fun y -> g y >>= fun () -> y () +;; + +f x +>>= function +| A -> + g y + >>= fun () -> + f x + >>= fun y -> + g y + >>= (function + | x -> + f x + >>= fun y -> + g y + >>= (function + | _ -> y ())) +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x;; +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x;; + +eeeeeeeeeeeee + eeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee + eeeeeeeeee +|> fun x -> x +;; + +eeeeeeeeeeeee + eeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee + eeeeeeeeee +|> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x;; +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x;; +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> fun xxxxxxxxx xxxxxxxxxxxxx -> x;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee +|> fun xxxxxxxx xxxxxxxxx xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee +|> fun xxxxxxxxxxxxx -> xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee +|> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> function +| x -> x +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> function +| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +;; + +eeeeeeeeeeeee + eeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee + eeeeeeeeee +|> function +| x -> x +;; + +eeeeeeeeeeeee + eeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee + eeeeeeeeee +|> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> function +| x -> x +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> function +| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee +|> function +| xxxxxxxxx, xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee +|> function +| xxxxxxxx, xxxxxxxxx, xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee +|> function +| xxxxxxxxxxxxx -> xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee +|> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx + +let parens = + match body with + | { pexp_desc = Pexp_function cs; pexp_attributes; pexp_loc } -> + update_config_maybe_disabled c pexp_loc pexp_attributes + @@ fun c -> + fmt "@ " + $ Cmts.fmt + c.cmts + pexp_loc + (wrap_if + parens + "(" + ")" + (fmt "function" $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box $ fmt "@ " $ fmt_cases c ctx cs)) + | _ -> close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody +;; + +let parens = + match body with + | { pexp_desc = Pexp_function cs; pexp_attributes; pexp_loc } -> + update_config_maybe_disabled c pexp_loc pexp_attributes + @@ (function + | _ -> + fmt "@ " + $ Cmts.fmt + c.cmts + pexp_loc + (wrap_if + parens + "(" + ")" + (fmt "function" $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box $ fmt "@ " $ fmt_cases c ctx cs)) + | _ -> close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody) +;; + +let end_gen_implementation ?toplevel ~ppf_dump (clambda : clambda_and_constants) = + Emit.begin_assembly (); + (clambda + ++ Profile.record "cmm" (Cmmgen.compunit ~ppf_dump) + ++ Profile.record "compile_phrases" (List.iter (compile_phrase ~ppf_dump)) + ++ fun () -> ()); + fooooooooooooooo +;; + +let foo = + (* get the tree origin *) + get_store_tree s + >>= function + | None -> f t >|= fun x -> Ok x (* no transaction is needed *) + | Some (origin, old_tree) -> + let batch = { repo; tree = old_tree; origin } in + let b = Batch batch in + foo +;; + +let _ = + foo + >>= function[@warning "-4"] + | A -> false + | B -> true +;; + +let _ = + foo + >>= function[@warning "-4"] + | Afoooooooooooooooooo fooooooooo -> false + | Bfoooooooooooooooooooooo fooooooooo -> true +;; + +let _ = foo >>= fun [@warning "-4"] x -> fooooooooooooooooooooooo + +let _ = + foo + >>= fun [@warning "-4"] x y -> + fooooooooooooooooooooooo + fooooooooooooooooooooooo + fooooooooooooooooooooooo + fooooooooooooooooooooooo +;; + +let _ = + foo + >>= function(* foo before *) [@warning "-4"] (* foo after *) + | Afoooooooooooooooooo fooooooooo -> false + | Bfoooooooooooooooooooooo fooooooooo -> true +;; + +let _ = + foo + >>= fun (* foo before *) [@warning "-4"] (* foo after *) x -> fooooooooooooooooooooooo +;; + +let f = + Ok () + >>= + (* *) + fun _ -> Ok () +;; + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () + >>= + (* *) + fun _ -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +let f = + Ok () + >>= + (* *) + function + | Foo -> Ok () +;; + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () + >>= + (* *) + function + | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + fun foooooo fooooo foooo foooooo -> + Ok foooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + function + | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +(** The tests below are testing a dropped comment with + `--no-break-infix-before-func` *) + +let _ = x |> fun y -> y (* *) + +let _ = + x + |> function + | y -> y (* *) +;; + +let _ = + match () with + | A -> + x + |> (function + | y -> y (* *)) + | B -> () +;; + +let _ = + x + |> function + | y -> + (function + | _ -> y (* A *)) +;; + +(* B *) +let _ = () (* This is needed here to avoid the comment above from moving *) + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k +;; + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k +;; + +let default = + command##hasPermission#=(fun ctx -> foooooooooooooooooo fooooooooooo); + command##hasPermission#=(fun ctx -> + foooooooooooooooooo fooooooooooo foooooo fooooooooo foooooooooo); + foo +;; + +let _ = ( let* ) x (fun y -> z) +let _ = ( let* ) x (function y -> z) +let _ = f (( let* ) x (fun y -> z)) +let _ = f (( let* ) x (function y -> z)) +let _ = (x >>= fun () -> ()) [@a] +let _ = ( >>= ) [@attr] +let _ = f (( >>= ) [@attr]);; + +( >>= ) [@attr] diff --git a/test/passing/refs.janestreet/infix_bind-fit_or_vertical-break.ml.ref b/test/passing/refs.janestreet/infix_bind-fit_or_vertical-break.ml.ref new file mode 100644 index 0000000000..b95ec737b4 --- /dev/null +++ b/test/passing/refs.janestreet/infix_bind-fit_or_vertical-break.ml.ref @@ -0,0 +1,330 @@ +f x +>>= fun y -> +g y +>>= fun () -> f x >>= fun y -> g y >>= fun () -> f x >>= fun y -> g y >>= fun () -> y () +;; + +f x +>>= function +| A -> + g y + >>= fun () -> + f x + >>= fun y -> + g y + >>= (function + | x -> + f x + >>= fun y -> + g y + >>= (function + | _ -> y ())) +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x;; +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x;; + +eeeeeeeeeeeee + eeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee + eeeeeeeeee +|> fun x -> x +;; + +eeeeeeeeeeeee + eeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee + eeeeeeeeee +|> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x;; +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x;; +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> fun xxxxxxxxx xxxxxxxxxxxxx -> x;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee +|> fun xxxxxxxx xxxxxxxxx xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee +|> fun xxxxxxxxxxxxx -> xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee +|> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> function +| x -> x +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> function +| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +;; + +eeeeeeeeeeeee + eeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee + eeeeeeeeee +|> function +| x -> x +;; + +eeeeeeeeeeeee + eeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee + eeeeeeeeee +|> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> function +| x -> x +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> function +| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee +|> function +| xxxxxxxxx, xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee +|> function +| xxxxxxxx, xxxxxxxxx, xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee +|> function +| xxxxxxxxxxxxx -> xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee +|> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx + +let parens = + match body with + | { pexp_desc = Pexp_function cs; pexp_attributes; pexp_loc } -> + update_config_maybe_disabled c pexp_loc pexp_attributes + @@ fun c -> + fmt "@ " + $ Cmts.fmt + c.cmts + pexp_loc + (wrap_if + parens + "(" + ")" + (fmt "function" + $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box + $ fmt "@ " + $ fmt_cases c ctx cs)) + | _ -> close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody +;; + +let parens = + match body with + | { pexp_desc = Pexp_function cs; pexp_attributes; pexp_loc } -> + update_config_maybe_disabled c pexp_loc pexp_attributes + @@ (function + | _ -> + fmt "@ " + $ Cmts.fmt + c.cmts + pexp_loc + (wrap_if + parens + "(" + ")" + (fmt "function" + $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box + $ fmt "@ " + $ fmt_cases c ctx cs)) + | _ -> close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody) +;; + +let end_gen_implementation ?toplevel ~ppf_dump (clambda : clambda_and_constants) = + Emit.begin_assembly (); + (clambda + ++ Profile.record "cmm" (Cmmgen.compunit ~ppf_dump) + ++ Profile.record "compile_phrases" (List.iter (compile_phrase ~ppf_dump)) + ++ fun () -> ()); + fooooooooooooooo +;; + +let foo = + (* get the tree origin *) + get_store_tree s + >>= function + | None -> f t >|= fun x -> Ok x (* no transaction is needed *) + | Some (origin, old_tree) -> + let batch = { repo; tree = old_tree; origin } in + let b = Batch batch in + foo +;; + +let _ = + foo + >>= function[@warning "-4"] + | A -> false + | B -> true +;; + +let _ = + foo + >>= function[@warning "-4"] + | Afoooooooooooooooooo fooooooooo -> false + | Bfoooooooooooooooooooooo fooooooooo -> true +;; + +let _ = foo >>= fun [@warning "-4"] x -> fooooooooooooooooooooooo + +let _ = + foo + >>= fun [@warning "-4"] x y -> + fooooooooooooooooooooooo + fooooooooooooooooooooooo + fooooooooooooooooooooooo + fooooooooooooooooooooooo +;; + +let _ = + foo + >>= function(* foo before *) [@warning "-4"] (* foo after *) + | Afoooooooooooooooooo fooooooooo -> false + | Bfoooooooooooooooooooooo fooooooooo -> true +;; + +let _ = + foo + >>= fun (* foo before *) [@warning "-4"] (* foo after *) x -> fooooooooooooooooooooooo +;; + +let f = + Ok () + >>= + (* *) + fun _ -> Ok () +;; + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () + >>= + (* *) + fun _ -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +let f = + Ok () + >>= + (* *) + function + | Foo -> Ok () +;; + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () + >>= + (* *) + function + | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + fun foooooo fooooo foooo foooooo -> + Ok foooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + function + | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +(** The tests below are testing a dropped comment with + `--no-break-infix-before-func` *) + +let _ = x |> fun y -> y (* *) + +let _ = + x + |> function + | y -> y (* *) +;; + +let _ = + match () with + | A -> + x + |> (function + | y -> y (* *)) + | B -> () +;; + +let _ = + x + |> function + | y -> + (function + | _ -> y (* A *)) +;; + +(* B *) +let _ = () (* This is needed here to avoid the comment above from moving *) + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k +;; + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k +;; + +let default = + command##hasPermission#=(fun ctx -> foooooooooooooooooo fooooooooooo); + command##hasPermission#=(fun ctx -> + foooooooooooooooooo fooooooooooo foooooo fooooooooo foooooooooo); + foo +;; + +let _ = ( let* ) x (fun y -> z) +let _ = ( let* ) x (function y -> z) +let _ = f (( let* ) x (fun y -> z)) +let _ = f (( let* ) x (function y -> z)) +let _ = (x >>= fun () -> ()) [@a] +let _ = ( >>= ) [@attr] +let _ = f (( >>= ) [@attr]);; + +( >>= ) [@attr] diff --git a/test/passing/refs.janestreet/infix_bind-fit_or_vertical.ml.ref b/test/passing/refs.janestreet/infix_bind-fit_or_vertical.ml.ref new file mode 100644 index 0000000000..73f6836de5 --- /dev/null +++ b/test/passing/refs.janestreet/infix_bind-fit_or_vertical.ml.ref @@ -0,0 +1,293 @@ +f x >>= fun y -> +g y >>= fun () -> +f x >>= fun y -> +g y >>= fun () -> +f x >>= fun y -> +g y >>= fun () -> y () +;; + +f x >>= function +| A -> + g y >>= fun () -> + f x >>= fun y -> + g y >>= ( function + | x -> + f x >>= fun y -> + g y >>= ( function + | _ -> y () ) ) +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x;; +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x;; + +eeeeeeeeeeeee + eeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee + eeeeeeeeee +|> fun x -> x +;; + +eeeeeeeeeeeee + eeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee + eeeeeeeeee +|> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x;; +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x;; +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> fun xxxxxxxxx xxxxxxxxxxxxx -> x;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee +|> fun xxxxxxxx xxxxxxxxx xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> fun xxxxxxxxxxxxx -> +xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee |> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function +| x -> x +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function +| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +;; + +eeeeeeeeeeeee + eeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee + eeeeeeeeee +|> function +| x -> x +;; + +eeeeeeeeeeeee + eeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee + eeeeeeeeee +|> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function +| x -> x +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function +| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function +| xxxxxxxxx, xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee |> function +| xxxxxxxx, xxxxxxxxx, xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function +| xxxxxxxxxxxxx -> xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee |> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx + +let parens = + match body with + | { pexp_desc = Pexp_function cs; pexp_attributes; pexp_loc } -> + update_config_maybe_disabled c pexp_loc pexp_attributes @@ fun c -> + fmt "@ " + $ Cmts.fmt + c.cmts + pexp_loc + (wrap_if + parens + "(" + ")" + (fmt "function" + $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box + $ fmt "@ " + $ fmt_cases c ctx cs)) + | _ -> close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody +;; + +let parens = + match body with + | { pexp_desc = Pexp_function cs; pexp_attributes; pexp_loc } -> + update_config_maybe_disabled c pexp_loc pexp_attributes @@ ( function + | _ -> + fmt "@ " + $ Cmts.fmt + c.cmts + pexp_loc + (wrap_if + parens + "(" + ")" + (fmt "function" + $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box + $ fmt "@ " + $ fmt_cases c ctx cs)) + | _ -> close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody ) +;; + +let end_gen_implementation ?toplevel ~ppf_dump (clambda : clambda_and_constants) = + Emit.begin_assembly (); + ( clambda + ++ Profile.record "cmm" (Cmmgen.compunit ~ppf_dump) + ++ Profile.record "compile_phrases" (List.iter (compile_phrase ~ppf_dump)) + ++ fun () -> () ); + fooooooooooooooo +;; + +let foo = + (* get the tree origin *) + get_store_tree s >>= function + | None -> f t >|= fun x -> Ok x (* no transaction is needed *) + | Some (origin, old_tree) -> + let batch = { repo; tree = old_tree; origin } in + let b = Batch batch in + foo +;; + +let _ = + foo >>= function[@warning "-4"] + | A -> false + | B -> true +;; + +let _ = + foo >>= function[@warning "-4"] + | Afoooooooooooooooooo fooooooooo -> false + | Bfoooooooooooooooooooooo fooooooooo -> true +;; + +let _ = foo >>= fun [@warning "-4"] x -> fooooooooooooooooooooooo + +let _ = + foo >>= fun [@warning "-4"] x y -> + fooooooooooooooooooooooo + fooooooooooooooooooooooo + fooooooooooooooooooooooo + fooooooooooooooooooooooo +;; + +let _ = + foo >>= function(* foo before *) [@warning "-4"] (* foo after *) + | Afoooooooooooooooooo fooooooooo -> false + | Bfoooooooooooooooooooooo fooooooooo -> true +;; + +let _ = + foo >>= fun (* foo before *) [@warning "-4"] (* foo after *) x -> + fooooooooooooooooooooooo +;; + +let f = Ok () >>= (* *) fun _ -> Ok () + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () >>= (* *) fun _ -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +let f = + Ok () >>= (* *) function + | Foo -> Ok () +;; + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () >>= (* *) function + | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + fun foooooo fooooo foooo foooooo -> + Ok foooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + function + | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +(** The tests below are testing a dropped comment with + `--no-break-infix-before-func` *) + +let _ = x |> fun y -> y (* *) + +let _ = + x |> function + | y -> y (* *) +;; + +let _ = + match () with + | A -> + x |> ( function + | y -> y (* *) ) + | B -> () +;; + +let _ = + x |> function + | y -> + (function + | _ -> y (* A *)) +;; + +(* B *) +let _ = () (* This is needed here to avoid the comment above from moving *) + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k +;; + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k +;; + +let default = + command##hasPermission #= (fun ctx -> foooooooooooooooooo fooooooooooo); + command##hasPermission #= (fun ctx -> + foooooooooooooooooo fooooooooooo foooooo fooooooooo foooooooooo); + foo +;; + +let _ = ( let* ) x (fun y -> z) +let _ = ( let* ) x (function y -> z) +let _ = f (( let* ) x (fun y -> z)) +let _ = f (( let* ) x (function y -> z)) +let _ = (x >>= fun () -> ()) [@a] +let _ = ( >>= ) [@attr] +let _ = f (( >>= ) [@attr]);; + +( >>= ) [@attr] diff --git a/test/passing/refs.janestreet/infix_bind.ml.ref b/test/passing/refs.janestreet/infix_bind.ml.ref new file mode 100644 index 0000000000..0ebb38f9ea --- /dev/null +++ b/test/passing/refs.janestreet/infix_bind.ml.ref @@ -0,0 +1,287 @@ +f x >>= fun y -> +g y >>= fun () -> +f x >>= fun y -> +g y >>= fun () -> +f x >>= fun y -> +g y >>= fun () -> y () +;; + +f x >>= function +| A -> + g y >>= fun () -> + f x >>= fun y -> + g y >>= ( function + | x -> + f x >>= fun y -> + g y >>= ( function + | _ -> y () ) ) +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x;; +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x;; + +eeeeeeeeeeeee + eeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee + eeeeeeeeee +|> fun x -> x +;; + +eeeeeeeeeeeee + eeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee + eeeeeeeeee +|> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x;; +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x;; +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> fun xxxxxxxxx xxxxxxxxxxxxx -> x;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee +|> fun xxxxxxxx xxxxxxxxx xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> fun xxxxxxxxxxxxx -> +xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee |> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function +| x -> x +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function +| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +;; + +eeeeeeeeeeeee + eeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee + eeeeeeeeee +|> function +| x -> x +;; + +eeeeeeeeeeeee + eeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeee + eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee + eeeeeeeeee +|> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function +| x -> x +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function +| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function +| xxxxxxxxx, xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee |> function +| xxxxxxxx, xxxxxxxxx, xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function +| xxxxxxxxxxxxx -> xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee |> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx + +let parens = + match body with + | { pexp_desc = Pexp_function cs; pexp_attributes; pexp_loc } -> + update_config_maybe_disabled c pexp_loc pexp_attributes @@ fun c -> + fmt "@ " + $ Cmts.fmt + c.cmts + pexp_loc + (wrap_if + parens + "(" + ")" + (fmt "function" $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box $ fmt "@ " $ fmt_cases c ctx cs)) + | _ -> close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody +;; + +let parens = + match body with + | { pexp_desc = Pexp_function cs; pexp_attributes; pexp_loc } -> + update_config_maybe_disabled c pexp_loc pexp_attributes @@ ( function + | _ -> + fmt "@ " + $ Cmts.fmt + c.cmts + pexp_loc + (wrap_if + parens + "(" + ")" + (fmt "function" $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box $ fmt "@ " $ fmt_cases c ctx cs)) + | _ -> close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody ) +;; + +let end_gen_implementation ?toplevel ~ppf_dump (clambda : clambda_and_constants) = + Emit.begin_assembly (); + ( clambda + ++ Profile.record "cmm" (Cmmgen.compunit ~ppf_dump) + ++ Profile.record "compile_phrases" (List.iter (compile_phrase ~ppf_dump)) + ++ fun () -> () ); + fooooooooooooooo +;; + +let foo = + (* get the tree origin *) + get_store_tree s >>= function + | None -> f t >|= fun x -> Ok x (* no transaction is needed *) + | Some (origin, old_tree) -> + let batch = { repo; tree = old_tree; origin } in + let b = Batch batch in + foo +;; + +let _ = + foo >>= function[@warning "-4"] + | A -> false + | B -> true +;; + +let _ = + foo >>= function[@warning "-4"] + | Afoooooooooooooooooo fooooooooo -> false + | Bfoooooooooooooooooooooo fooooooooo -> true +;; + +let _ = foo >>= fun [@warning "-4"] x -> fooooooooooooooooooooooo + +let _ = + foo >>= fun [@warning "-4"] x y -> + fooooooooooooooooooooooo + fooooooooooooooooooooooo + fooooooooooooooooooooooo + fooooooooooooooooooooooo +;; + +let _ = + foo >>= function(* foo before *) [@warning "-4"] (* foo after *) + | Afoooooooooooooooooo fooooooooo -> false + | Bfoooooooooooooooooooooo fooooooooo -> true +;; + +let _ = + foo >>= fun (* foo before *) [@warning "-4"] (* foo after *) x -> + fooooooooooooooooooooooo +;; + +let f = Ok () >>= (* *) fun _ -> Ok () + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () >>= (* *) fun _ -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +let f = + Ok () >>= (* *) function + | Foo -> Ok () +;; + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () >>= (* *) function + | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + fun foooooo fooooo foooo foooooo -> + Ok foooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + function + | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo +;; + +(** The tests below are testing a dropped comment with + `--no-break-infix-before-func` *) + +let _ = x |> fun y -> y (* *) + +let _ = + x |> function + | y -> y (* *) +;; + +let _ = + match () with + | A -> + x |> ( function + | y -> y (* *) ) + | B -> () +;; + +let _ = + x |> function + | y -> + (function + | _ -> y (* A *)) +;; + +(* B *) +let _ = () (* This is needed here to avoid the comment above from moving *) + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k +;; + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k +;; + +let default = + command##hasPermission #= (fun ctx -> foooooooooooooooooo fooooooooooo); + command##hasPermission #= (fun ctx -> + foooooooooooooooooo fooooooooooo foooooo fooooooooo foooooooooo); + foo +;; + +let _ = ( let* ) x (fun y -> z) +let _ = ( let* ) x (function y -> z) +let _ = f (( let* ) x (fun y -> z)) +let _ = f (( let* ) x (function y -> z)) +let _ = (x >>= fun () -> ()) [@a] +let _ = ( >>= ) [@attr] +let _ = f (( >>= ) [@attr]);; + +( >>= ) [@attr] diff --git a/test/passing/refs.janestreet/infix_precedence.ml.ref b/test/passing/refs.janestreet/infix_precedence.ml.ref new file mode 100644 index 0000000000..a0336450f5 --- /dev/null +++ b/test/passing/refs.janestreet/infix_precedence.ml.ref @@ -0,0 +1,13 @@ +let dolore_tempor_in_duis duis_esse esse = + let duis_nisi = Occaecat.sed_duis_nisi duis_esse in + do_dolore_quis_dolore duis_nisi esse + || ((not + (match duis_nisi with + | Qui.Occaecat.Enim esse_magna -> Qui.Occaecat.Enim.do_commodo_dolore esse_magna + | _ -> false)) + && Occaecat.sed_aliqua duis_esse <> PariAtur.Aliquip + && not + (Adipisicing.magna_tempor_ipsum_elit_nisi + duis_esse + Adipisicing.loremipSumDolorsi)) +;; diff --git a/test/passing/refs.janestreet/injectivity.ml.ref b/test/passing/refs.janestreet/injectivity.ml.ref new file mode 100644 index 0000000000..93cb814548 --- /dev/null +++ b/test/passing/refs.janestreet/injectivity.ml.ref @@ -0,0 +1,76 @@ +type !'a t = private 'a ref +type +!'a t = private 'a +type -!'a t = private 'a -> unit +type +!'a t = private 'a +type -!'a t = private 'a -> unit +type +!'a t = private 'a +type -!'a t = private 'a -> unit +type +!'a t = private 'a +type -!'a t = private 'a -> unit + +module M : sig + type +!'a t +end = struct + type 'a t = 'a list +end + +module N : sig + type +'a t +end = struct + type 'a t = 'a list +end + +type !'a t = 'a list +type !'a u = int + +module M : sig + type !'a t = private < m : int ; .. > +end = struct + type 'a t = < m : int > +end + +type 'a t = 'b constraint 'a = < b : 'b > +type !'b u = < b : 'b > t +type !_ t = X +type (_, _) eq = Refl : ('a, 'a) eq +type !'a t = private 'b constraint 'a = < b : 'b > +type !'a t = private 'b constraint 'a = < b : 'b ; c : 'c > + +module M : sig + type !'a t constraint 'a = < b : 'b ; c : 'c > +end = struct + type nonrec 'a t = 'a t +end + +type !'a u = int constraint 'a = 'b t + +module F (X : sig + type 'a t + end) = +struct + type !'a u = 'b constraint 'a = < b : 'b > constraint 'b = _ X.t +end + +module F (X : sig + type 'a t + end) = +struct + type !'a u = 'b X.t constraint 'a = < b : 'b X.t > +end + +module F (X : sig + type 'a t + end) = +struct + type !'a u = 'b constraint 'a = < b : (_ X.t as 'b) > +end + +module rec R : sig + type !'a t = [ `A of 'a S.t ] +end = + R + +and S : sig + type !'a t = 'a R.t +end = + S diff --git a/test/passing/refs.janestreet/into_infix.ml.ref b/test/passing/refs.janestreet/into_infix.ml.ref new file mode 100644 index 0000000000..f55d9f49d1 --- /dev/null +++ b/test/passing/refs.janestreet/into_infix.ml.ref @@ -0,0 +1 @@ +let a = 1 < 3 diff --git a/test/passing/refs.janestreet/invalid.ml.ref b/test/passing/refs.janestreet/invalid.ml.ref new file mode 100644 index 0000000000..7c3ae311aa --- /dev/null +++ b/test/passing/refs.janestreet/invalid.ml.ref @@ -0,0 +1,14 @@ +let f = function + | "as" .. 3 | 3. .. 'q' | 3 .. -3. | -3. .. 3 -> () +;; + +let f = function + | (lazy (exception A)) -> () + | exception (lazy A) -> () +;; + +let f = (A) a b +let f = (A x) a b +let f = (`A) a b +let f = (`A x) a b +let f = (( :: )) a b c diff --git a/test/passing/refs.janestreet/invalid_docstring.ml.ref b/test/passing/refs.janestreet/invalid_docstring.ml.ref new file mode 100644 index 0000000000..3c220e968d --- /dev/null +++ b/test/passing/refs.janestreet/invalid_docstring.ml.ref @@ -0,0 +1 @@ +(**{v*) diff --git a/test/passing/refs.janestreet/invalid_docstrings.mli.ref b/test/passing/refs.janestreet/invalid_docstrings.mli.ref new file mode 100644 index 0000000000..1666ba06e6 --- /dev/null +++ b/test/passing/refs.janestreet/invalid_docstrings.mli.ref @@ -0,0 +1,8 @@ +(** Blablabla. Otherwise, the given protocol can not be: + {ul + {- registered into {!resolvers}} + {- used as a service with {!serve_with_handler]/{!serve}}} + [protocol] can be hidden - but must be registered with + {!register_protocol}. However, blablabla. +*) +val x : y diff --git a/test/passing/refs.janestreet/issue114.ml.ref b/test/passing/refs.janestreet/issue114.ml.ref new file mode 100644 index 0000000000..dbbb06ff33 --- /dev/null +++ b/test/passing/refs.janestreet/issue114.ml.ref @@ -0,0 +1 @@ +let () = (f ()).(2) <- e diff --git a/test/passing/refs.janestreet/issue1750.ml.ref b/test/passing/refs.janestreet/issue1750.ml.ref new file mode 100644 index 0000000000..4d1b86b733 --- /dev/null +++ b/test/passing/refs.janestreet/issue1750.ml.ref @@ -0,0 +1,79 @@ +let _ = + all + [ all + [ all + [ all + [ f + (all + [ all + [ all + [ all + [ all + [ all + [ all + [ all + [ all + [ all + [ all + [ all + [ all + [ all [ identify ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ]) + ] + ] + ] + ] +;; + +let _ = function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | _ -> ()] -> ()] -> + ()] -> ()] -> ()] -> ()] + -> ()] -> ()] -> ()] -> ()] -> ()] -> ()] + -> ()] -> ()] -> ()] -> ()] -> ()] -> () +;; diff --git a/test/passing/refs.janestreet/issue289.ml.ref b/test/passing/refs.janestreet/issue289.ml.ref new file mode 100644 index 0000000000..c405130deb --- /dev/null +++ b/test/passing/refs.janestreet/issue289.ml.ref @@ -0,0 +1,73 @@ +[@@@ocamlformat "wrap-fun-args=false"] + +let foo = + let open Gql in + [ field "id" ~doc:"Toy ID." ~args:[] ~typ:(non_null guid) ~resolve:(function _ctx -> + x.id) + ; field "id" ~doc:"Toy ID." ~args:[] ~typppp ~resolve:(function _ctx -> x.id) + ; field "id" ~doc:"Toy ID." ~args:[] ~typ:(non_null guid) ~resolve:(function + | A -> x.id + | B -> c) + ; field "id" ~doc:"Toy ID." ~args:[] ~resolve:(function + | A -> x.id + | B -> c) + ; field "id" ~doc:"Toy ID." ~args:[] ~typppppppppppppppppppp ~resolve:(function + | AAAAAAAAAAAAAAAAAAAa -> x.idddddddddddddddddddddddddd + | BBBBBBBBBBBBBBBB -> ccccccccccccccccccccccc) + ; field "id" ~doc:"Toy ID." ~args:[] ~resolve:(function + | AAAAAAAAAAAAAAAAAAAa -> x.idddddddddddddddddddddddddd + | BBBBBBBBBBBBBBBB -> ccccccccccccccccccccccc) + ; field "id" ~doc:"Toy ID." ~args:[] ~typ:(non_null guid) ~resolve:(fun _ctx x -> x.id) + ; field "name" ~doc:"Toy name." ~args:[] ~typ:(non_null string) ~resolve:(fun _ctx x -> + x.name) + ; field + "description" + ~doc:"Toy description." + ~args:[] + ~typ:string + ~resolve:(fun _ctx x -> x.description |> Util.option_of_string) + ; field + "type" + ~doc:"Toy type. Possible values are: car, animal, train." + ~args:[] + ~typ:(non_null toy_type_enum) + ~resolve:(fun _ctx x -> x.toy_type) + ; field + "createdAt" + ~doc:"Date created." + ~args:[] + ~typ:(non_null Scalar.date_time) + ~resolve:(fun _ctx x -> x.created_at) + ] +;; + +[@@@ocamlformat "wrap-fun-args=true"] + +let foo = + let open Gql in + [ field "id" ~doc:"Toy ID." ~args:[] ~typ:(non_null guid) ~resolve:(function _ctx -> + x.id) + ; field "id" ~doc:"Toy ID." ~args:[] ~typppp ~resolve:(function _ctx -> x.id) + ; field "id" ~doc:"Toy ID." ~args:[] ~typ:(non_null guid) ~resolve:(function + | A -> x.id + | B -> c) + ; field "id" ~doc:"Toy ID." ~args:[] ~resolve:(function + | A -> x.id + | B -> c) + ; field "id" ~doc:"Toy ID." ~args:[] ~typppppppppppppppppppp ~resolve:(function + | AAAAAAAAAAAAAAAAAAAa -> x.idddddddddddddddddddddddddd + | BBBBBBBBBBBBBBBB -> ccccccccccccccccccccccc) + ; field "id" ~doc:"Toy ID." ~args:[] ~resolve:(function + | AAAAAAAAAAAAAAAAAAAa -> x.idddddddddddddddddddddddddd + | BBBBBBBBBBBBBBBB -> ccccccccccccccccccccccc) + ; field "id" ~doc:"Toy ID." ~args:[] ~typ:(non_null guid) ~resolve:(fun _ctx x -> x.id) + ; field "name" ~doc:"Toy name." ~args:[] ~typ:(non_null string) ~resolve:(fun _ctx x -> + x.name) + ; field "description" ~doc:"Toy description." ~args:[] ~typ:string + ~resolve:(fun _ctx x -> x.description |> Util.option_of_string) + ; field "type" ~doc:"Toy type. Possible values are: car, animal, train." ~args:[] + ~typ:(non_null toy_type_enum) ~resolve:(fun _ctx x -> x.toy_type) + ; field "createdAt" ~doc:"Date created." ~args:[] ~typ:(non_null Scalar.date_time) + ~resolve:(fun _ctx x -> x.created_at) + ] +;; diff --git a/test/passing/refs.janestreet/issue48.ml.ref b/test/passing/refs.janestreet/issue48.ml.ref new file mode 100644 index 0000000000..6e59f8718d --- /dev/null +++ b/test/passing/refs.janestreet/issue48.ml.ref @@ -0,0 +1,3 @@ +module X (* : sig val x : unit -> unit end *) = struct + let x () = print_endline "coucou" +end diff --git a/test/passing/refs.janestreet/issue51.ml.ref b/test/passing/refs.janestreet/issue51.ml.ref new file mode 100644 index 0000000000..491df29a4e --- /dev/null +++ b/test/passing/refs.janestreet/issue51.ml.ref @@ -0,0 +1 @@ +val run : unit -> (unit -> ('a, ([> `Msg of string ] as 'b)) result) -> ('a, 'b) result diff --git a/test/passing/refs.janestreet/issue57.ml.ref b/test/passing/refs.janestreet/issue57.ml.ref new file mode 100644 index 0000000000..778d6f8121 --- /dev/null +++ b/test/passing/refs.janestreet/issue57.ml.ref @@ -0,0 +1,6 @@ +let f (`A x) = x + +let f x = + let (`A y) = x in + y +;; diff --git a/test/passing/refs.janestreet/issue60.ml.ref b/test/passing/refs.janestreet/issue60.ml.ref new file mode 100644 index 0000000000..07a9b8e409 --- /dev/null +++ b/test/passing/refs.janestreet/issue60.ml.ref @@ -0,0 +1 @@ +let x : unit = () diff --git a/test/passing/refs.janestreet/issue77.ml.ref b/test/passing/refs.janestreet/issue77.ml.ref new file mode 100644 index 0000000000..579db9f4c6 --- /dev/null +++ b/test/passing/refs.janestreet/issue77.ml.ref @@ -0,0 +1,10 @@ +let div = + [ div + ~a: + [ Reactive.a_style + (React.S.map (sprintf "height: %dpx") (State.player_height_signal app_state)) + (* ksprintf a_style "%s" (if_smth "min-height: 300px;" ""); *) + ] + content + ] +;; diff --git a/test/passing/refs.janestreet/issue85.ml.ref b/test/passing/refs.janestreet/issue85.ml.ref new file mode 100644 index 0000000000..cb8f202413 --- /dev/null +++ b/test/passing/refs.janestreet/issue85.ml.ref @@ -0,0 +1,7 @@ +let f (module X) = X.x + +let f = function + | `A { x : int = _ } -> () +;; + +let f (`A | `B) = () diff --git a/test/passing/refs.janestreet/issue89.ml.ref b/test/passing/refs.janestreet/issue89.ml.ref new file mode 100644 index 0000000000..6a9b7db0c4 --- /dev/null +++ b/test/passing/refs.janestreet/issue89.ml.ref @@ -0,0 +1 @@ +let f x = !(x.(0)) diff --git a/test/passing/refs.janestreet/ite-compact.ml.err b/test/passing/refs.janestreet/ite-compact.ml.err new file mode 100644 index 0000000000..f2b48029de --- /dev/null +++ b/test/passing/refs.janestreet/ite-compact.ml.err @@ -0,0 +1 @@ +Warning: ite-compact.ml:37 exceeds the margin diff --git a/test/passing/refs.janestreet/ite-compact.ml.ref b/test/passing/refs.janestreet/ite-compact.ml.ref new file mode 100644 index 0000000000..fc3cff5ffc --- /dev/null +++ b/test/passing/refs.janestreet/ite-compact.ml.ref @@ -0,0 +1,179 @@ +let _ = + if b then e + else ( + e1; + e2) +;; + +let _ = + if b then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +;; + +let _ = + if b then ( + e1; + e2) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +;; + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else e +;; + +f (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then () else ());; +f (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ());; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () + else ()) + +let () = + f + (if a___________________________________________________________________ then + b_________________________________________________________________ + else c_________________________________________________________________) +;; + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition then ( + let a = 1 in + let b = 2 in + a + b) + else if other_condition then 12 + else 0 +;; + +let _ = + if foo then ( + let a = 1 in + let b = 2 in + a + b) + else if foo then 12 + else 0 +;; + +let foo = + if is_sugared_list e2 then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) +;; + +let foo = + if is_sugared_list e2 then Some (Semi, Non) + else + Some + ( ColonColon + , if exp == e2 then Right + else Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo ) +;; + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) +;; + +let foo = + if some condition then if some nested condition then some action else some other action + else some default action +;; + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else some other action + else some default action +;; + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b +;; + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then foo +;; + +let _ = + if fooo then ( + ) else if bar then ( * ) [@attr] else if foobar then ( / ) else ( - ) +;; + +let _ = + if x then fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz +;; + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then foooooooooooooooooooooooooooooooooooooooooo + else foooooooooooooooooooooooooooooooooooooooooo +;; + +let _ = + if + (* foo *) + foo + then 0 + else if + (* bar *) + bar + then 1 + else 2 +;; + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 +;; + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.janestreet/ite-compact_closing.ml.err b/test/passing/refs.janestreet/ite-compact_closing.ml.err new file mode 100644 index 0000000000..ebb74f6571 --- /dev/null +++ b/test/passing/refs.janestreet/ite-compact_closing.ml.err @@ -0,0 +1 @@ +Warning: ite-compact_closing.ml:41 exceeds the margin diff --git a/test/passing/refs.janestreet/ite-compact_closing.ml.ref b/test/passing/refs.janestreet/ite-compact_closing.ml.ref new file mode 100644 index 0000000000..52c6eaebd2 --- /dev/null +++ b/test/passing/refs.janestreet/ite-compact_closing.ml.ref @@ -0,0 +1,191 @@ +let _ = + if b then e + else ( + e1; + e2 + ) +;; + +let _ = + if b then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) +;; + +let _ = + if b then ( + e1; + e2 + ) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) +;; + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + else e +;; + +f (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then () else ());; +f (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ());; +f (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ()) +;; + +f + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () + else () + ) + +let () = + f + ( if a___________________________________________________________________ then + b_________________________________________________________________ + else c_________________________________________________________________ + ) +;; + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition then ( + let a = 1 in + let b = 2 in + a + b + ) + else if other_condition then 12 + else 0 +;; + +let _ = + if foo then ( + let a = 1 in + let b = 2 in + a + b + ) + else if foo then 12 + else 0 +;; + +let foo = + if is_sugared_list e2 then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) +;; + +let foo = + if is_sugared_list e2 then Some (Semi, Non) + else + Some + ( ColonColon + , if exp == e2 then Right + else Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo + ) +;; + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) + else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) +;; + +let foo = + if some condition then if some nested condition then some action else some other action + else some default action +;; + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else some other action + else some default action +;; + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b +;; + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then foo +;; + +let _ = + if fooo then ( + ) else if bar then ( * ) [@attr] else if foobar then ( / ) else ( - ) +;; + +let _ = + if x then fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz +;; + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then foooooooooooooooooooooooooooooooooooooooooo + else foooooooooooooooooooooooooooooooooooooooooo +;; + +let _ = + if + (* foo *) + foo + then 0 + else if + (* bar *) + bar + then 1 + else 2 +;; + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 +;; + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.janestreet/ite-fit_or_vertical.ml.ref b/test/passing/refs.janestreet/ite-fit_or_vertical.ml.ref new file mode 100644 index 0000000000..21220c0dae --- /dev/null +++ b/test/passing/refs.janestreet/ite-fit_or_vertical.ml.ref @@ -0,0 +1,227 @@ +let _ = + if b then + e + else ( + e1; + e2) +;; + +let _ = + if b then + e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +;; + +let _ = + if b then ( + e1; + e2) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +;; + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else + e +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then + () + else + ()) +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) +;; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) + +let () = + f + (if a___________________________________________________________________ then + b_________________________________________________________________ + else + c_________________________________________________________________) +;; + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition then ( + let a = 1 in + let b = 2 in + a + b) + else if other_condition then + 12 + else + 0 +;; + +let _ = + if foo then ( + let a = 1 in + let b = 2 in + a + b) + else if foo then + 12 + else + 0 +;; + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some (ColonColon, if exp == e2 then Right else Left) +;; + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon + , if exp == e2 then + Right + else + Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo ) +;; + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) +;; + +let foo = + if some condition then + if some nested condition then some action else some other action + else + some default action +;; + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else + some other action + else + some default action +;; + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b +;; + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo +;; + +let _ = + if fooo then + ( + ) + else if bar then + ( * ) [@attr] + else if foobar then + ( / ) + else + ( - ) +;; + +let _ = + if x then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz +;; + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then + foooooooooooooooooooooooooooooooooooooooooo + else + foooooooooooooooooooooooooooooooooooooooooo +;; + +let _ = + if + (* foo *) + foo + then + 0 + else if + (* bar *) + bar + then + 1 + else + 2 +;; + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 +;; + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.janestreet/ite-fit_or_vertical_closing.ml.ref b/test/passing/refs.janestreet/ite-fit_or_vertical_closing.ml.ref new file mode 100644 index 0000000000..ba4853c38f --- /dev/null +++ b/test/passing/refs.janestreet/ite-fit_or_vertical_closing.ml.ref @@ -0,0 +1,237 @@ +let _ = + if b then + e + else ( + e1; + e2 + ) +;; + +let _ = + if b then + e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) +;; + +let _ = + if b then ( + e1; + e2 + ) else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) +;; + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) else + e +;; + +f + ( if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then + () + else + () + ) +;; + +f + ( if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + () + ) +;; + +f + ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + () + ) +;; + +f + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + () + ) + +let () = + f + ( if a___________________________________________________________________ then + b_________________________________________________________________ + else + c_________________________________________________________________ + ) +;; + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition then ( + let a = 1 in + let b = 2 in + a + b + ) else if other_condition then + 12 + else + 0 +;; + +let _ = + if foo then ( + let a = 1 in + let b = 2 in + a + b + ) else if foo then + 12 + else + 0 +;; + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some (ColonColon, if exp == e2 then Right else Left) +;; + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon + , if exp == e2 then + Right + else + Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo + ) +;; + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) +;; + +let foo = + if some condition then + if some nested condition then some action else some other action + else + some default action +;; + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else + some other action + else + some default action +;; + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b +;; + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo +;; + +let _ = + if fooo then + ( + ) + else if bar then + ( * ) [@attr] + else if foobar then + ( / ) + else + ( - ) +;; + +let _ = + if x then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz +;; + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then + foooooooooooooooooooooooooooooooooooooooooo + else + foooooooooooooooooooooooooooooooooooooooooo +;; + +let _ = + if + (* foo *) + foo + then + 0 + else if + (* bar *) + bar + then + 1 + else + 2 +;; + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 +;; + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.janestreet/ite-fit_or_vertical_no_indicate.ml.ref b/test/passing/refs.janestreet/ite-fit_or_vertical_no_indicate.ml.ref new file mode 100644 index 0000000000..21220c0dae --- /dev/null +++ b/test/passing/refs.janestreet/ite-fit_or_vertical_no_indicate.ml.ref @@ -0,0 +1,227 @@ +let _ = + if b then + e + else ( + e1; + e2) +;; + +let _ = + if b then + e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +;; + +let _ = + if b then ( + e1; + e2) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +;; + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else + e +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then + () + else + ()) +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) +;; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) + +let () = + f + (if a___________________________________________________________________ then + b_________________________________________________________________ + else + c_________________________________________________________________) +;; + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition then ( + let a = 1 in + let b = 2 in + a + b) + else if other_condition then + 12 + else + 0 +;; + +let _ = + if foo then ( + let a = 1 in + let b = 2 in + a + b) + else if foo then + 12 + else + 0 +;; + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some (ColonColon, if exp == e2 then Right else Left) +;; + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon + , if exp == e2 then + Right + else + Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo ) +;; + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) +;; + +let foo = + if some condition then + if some nested condition then some action else some other action + else + some default action +;; + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else + some other action + else + some default action +;; + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b +;; + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo +;; + +let _ = + if fooo then + ( + ) + else if bar then + ( * ) [@attr] + else if foobar then + ( / ) + else + ( - ) +;; + +let _ = + if x then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz +;; + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then + foooooooooooooooooooooooooooooooooooooooooo + else + foooooooooooooooooooooooooooooooooooooooooo +;; + +let _ = + if + (* foo *) + foo + then + 0 + else if + (* bar *) + bar + then + 1 + else + 2 +;; + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 +;; + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.janestreet/ite-kr.ml.ref b/test/passing/refs.janestreet/ite-kr.ml.ref new file mode 100644 index 0000000000..434f160f0a --- /dev/null +++ b/test/passing/refs.janestreet/ite-kr.ml.ref @@ -0,0 +1,273 @@ +let _ = + if b then + e + else ( + e1; + e2 + ) +;; + +let _ = + if b then + e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) +;; + +let _ = + if b then ( + e1; + e2 + ) else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) +;; + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) else + e +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then + () + else + ()) +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) +;; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) + +let () = + f + (if a___________________________________________________________________ then + b_________________________________________________________________ + else + c_________________________________________________________________) +;; + +let () = + if [@test] true then + () + else if [@other] true then + () +;; + +let foo = + if cond1 then + arm1 + else if cond2 then + arm2 + else + arm3 +;; + +let _ = + if condition then ( + let a = 1 in + let b = 2 in + a + b + ) else if other_condition then + 12 + else + 0 +;; + +let _ = + if foo then ( + let a = 1 in + let b = 2 in + a + b + ) else if foo then + 12 + else + 0 +;; + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon + , if exp == e2 then + Right + else + Left ) +;; + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon + , if exp == e2 then + Right + else + Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo ) +;; + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) +;; + +let foo = + if some condition then + if some nested condition then + some action + else + some other action + else + some default action +;; + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else + some other action + else + some default action +;; + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b +;; + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b +;; + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo +;; + +let _ = + if fooo then + ( + ) + else if bar then + ( * ) + [@attr] + else if foobar then + ( / ) + else + ( - ) +;; + +let _ = + if x then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz +;; + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then + foooooooooooooooooooooooooooooooooooooooooo + else + foooooooooooooooooooooooooooooooooooooooooo +;; + +let _ = + if + (* foo *) + foo + then + 0 + else if + (* bar *) + bar + then + 1 + else + 2 +;; + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 +;; + +let _ = + if x then + 42 + (* dummy *) + else + y +;; + +let _ = + if x then + 42 + (* dummy *) + else if y then + z + else + w +;; diff --git a/test/passing/refs.janestreet/ite-kr_closing.ml.ref b/test/passing/refs.janestreet/ite-kr_closing.ml.ref new file mode 100644 index 0000000000..1909905de4 --- /dev/null +++ b/test/passing/refs.janestreet/ite-kr_closing.ml.ref @@ -0,0 +1,280 @@ +let _ = + if b then + e + else ( + e1; + e2 + ) +;; + +let _ = + if b then + e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) +;; + +let _ = + if b then ( + e1; + e2 + ) else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) +;; + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) else + e +;; + +f + ( if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then + () + else + () + ) +;; + +f + ( if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + () + ) +;; + +f + ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + () + ) +;; + +f + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + () + ) + +let () = + f + ( if a___________________________________________________________________ then + b_________________________________________________________________ + else + c_________________________________________________________________ + ) +;; + +let () = + if [@test] true then + () + else if [@other] true then + () +;; + +let foo = + if cond1 then + arm1 + else if cond2 then + arm2 + else + arm3 +;; + +let _ = + if condition then ( + let a = 1 in + let b = 2 in + a + b + ) else if other_condition then + 12 + else + 0 +;; + +let _ = + if foo then ( + let a = 1 in + let b = 2 in + a + b + ) else if foo then + 12 + else + 0 +;; + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon + , if exp == e2 then + Right + else + Left + ) +;; + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon + , if exp == e2 then + Right + else + Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo + ) +;; + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) +;; + +let foo = + if some condition then + if some nested condition then + some action + else + some other action + else + some default action +;; + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else + some other action + else + some default action +;; + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b +;; + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b +;; + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo +;; + +let _ = + if fooo then + ( + ) + else if bar then + ( * ) + [@attr] + else if foobar then + ( / ) + else + ( - ) +;; + +let _ = + if x then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz +;; + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then + foooooooooooooooooooooooooooooooooooooooooo + else + foooooooooooooooooooooooooooooooooooooooooo +;; + +let _ = + if + (* foo *) + foo + then + 0 + else if + (* bar *) + bar + then + 1 + else + 2 +;; + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 +;; + +let _ = + if x then + 42 + (* dummy *) + else + y +;; + +let _ = + if x then + 42 + (* dummy *) + else if y then + z + else + w +;; diff --git a/test/passing/refs.janestreet/ite-kw_first.ml.err b/test/passing/refs.janestreet/ite-kw_first.ml.err new file mode 100644 index 0000000000..9acbf58235 --- /dev/null +++ b/test/passing/refs.janestreet/ite-kw_first.ml.err @@ -0,0 +1 @@ +Warning: ite-kw_first.ml:42 exceeds the margin diff --git a/test/passing/refs.janestreet/ite-kw_first.ml.ref b/test/passing/refs.janestreet/ite-kw_first.ml.ref new file mode 100644 index 0000000000..13e2d494ae --- /dev/null +++ b/test/passing/refs.janestreet/ite-kw_first.ml.ref @@ -0,0 +1,206 @@ +let _ = + if b + then e + else ( + e1; + e2) +;; + +let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +;; + +let _ = + if b + then ( + e1; + e2) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +;; + +let _ = + if b + then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else if b1 + then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else e +;; + +f (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then () else ());; +f (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ());; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then () + else ()) + +let () = + f + (if a___________________________________________________________________ + then b_________________________________________________________________ + else c_________________________________________________________________) +;; + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition + then ( + let a = 1 in + let b = 2 in + a + b) + else if other_condition + then 12 + else 0 +;; + +let _ = + if foo + then ( + let a = 1 in + let b = 2 in + a + b) + else if foo + then 12 + else 0 +;; + +let foo = + if is_sugared_list e2 + then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) +;; + +let foo = + if is_sugared_list e2 + then Some (Semi, Non) + else + Some + ( ColonColon + , if exp == e2 + then Right + else Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo ) +;; + +let foo = + if cond1 + then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else if cond2 + then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) +;; + +let foo = + if some condition + then if some nested condition then some action else some other action + else some default action +;; + +let foo = + if some condition + then + if some nested condition + then some action + foooo + foooo + foooooooo + foooo + foooooo + else some other action + else some default action +;; + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 + then (* foo *) + a + b + else (* foo *) + a - b +;; + +let foo = + if cmp < 0 + then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 + then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) + then foo +;; + +let _ = + if fooo then ( + ) else if bar then ( * ) [@attr] else if foobar then ( / ) else ( - ) +;; + +let _ = + if x + then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz +;; + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then foooooooooooooooooooooooooooooooooooooooooo + else foooooooooooooooooooooooooooooooooooooooooo +;; + +let _ = + if + (* foo *) + foo + then 0 + else if + (* bar *) + bar + then 1 + else 2 +;; + +let compare s1 s2 = + if String.equal s1 s2 + then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options + then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options + then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 +;; + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.janestreet/ite-kw_first_closing.ml.err b/test/passing/refs.janestreet/ite-kw_first_closing.ml.err new file mode 100644 index 0000000000..b28ec2c689 --- /dev/null +++ b/test/passing/refs.janestreet/ite-kw_first_closing.ml.err @@ -0,0 +1 @@ +Warning: ite-kw_first_closing.ml:46 exceeds the margin diff --git a/test/passing/refs.janestreet/ite-kw_first_closing.ml.ref b/test/passing/refs.janestreet/ite-kw_first_closing.ml.ref new file mode 100644 index 0000000000..86c4febac1 --- /dev/null +++ b/test/passing/refs.janestreet/ite-kw_first_closing.ml.ref @@ -0,0 +1,218 @@ +let _ = + if b + then e + else ( + e1; + e2 + ) +;; + +let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) +;; + +let _ = + if b + then ( + e1; + e2 + ) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) +;; + +let _ = + if b + then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + else if b1 + then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more + ) + else e +;; + +f (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then () else ());; +f (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ());; +f (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ()) +;; + +f + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then () + else () + ) + +let () = + f + ( if a___________________________________________________________________ + then b_________________________________________________________________ + else c_________________________________________________________________ + ) +;; + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition + then ( + let a = 1 in + let b = 2 in + a + b + ) + else if other_condition + then 12 + else 0 +;; + +let _ = + if foo + then ( + let a = 1 in + let b = 2 in + a + b + ) + else if foo + then 12 + else 0 +;; + +let foo = + if is_sugared_list e2 + then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) +;; + +let foo = + if is_sugared_list e2 + then Some (Semi, Non) + else + Some + ( ColonColon + , if exp == e2 + then Right + else Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo + ) +;; + +let foo = + if cond1 + then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) + else if cond2 + then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) + ) +;; + +let foo = + if some condition + then if some nested condition then some action else some other action + else some default action +;; + +let foo = + if some condition + then + if some nested condition + then some action + foooo + foooo + foooooooo + foooo + foooooo + else some other action + else some default action +;; + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 + then (* foo *) + a + b + else (* foo *) + a - b +;; + +let foo = + if cmp < 0 + then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 + then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) + then foo +;; + +let _ = + if fooo then ( + ) else if bar then ( * ) [@attr] else if foobar then ( / ) else ( - ) +;; + +let _ = + if x + then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz +;; + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then foooooooooooooooooooooooooooooooooooooooooo + else foooooooooooooooooooooooooooooooooooooooooo +;; + +let _ = + if + (* foo *) + foo + then 0 + else if + (* bar *) + bar + then 1 + else 2 +;; + +let compare s1 s2 = + if String.equal s1 s2 + then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options + then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options + then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 +;; + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.janestreet/ite-kw_first_no_indicate.ml.err b/test/passing/refs.janestreet/ite-kw_first_no_indicate.ml.err new file mode 100644 index 0000000000..f4ca604fbf --- /dev/null +++ b/test/passing/refs.janestreet/ite-kw_first_no_indicate.ml.err @@ -0,0 +1 @@ +Warning: ite-kw_first_no_indicate.ml:42 exceeds the margin diff --git a/test/passing/refs.janestreet/ite-kw_first_no_indicate.ml.ref b/test/passing/refs.janestreet/ite-kw_first_no_indicate.ml.ref new file mode 100644 index 0000000000..13e2d494ae --- /dev/null +++ b/test/passing/refs.janestreet/ite-kw_first_no_indicate.ml.ref @@ -0,0 +1,206 @@ +let _ = + if b + then e + else ( + e1; + e2) +;; + +let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +;; + +let _ = + if b + then ( + e1; + e2) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +;; + +let _ = + if b + then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else if b1 + then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else e +;; + +f (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then () else ());; +f (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ());; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + then () + else ()) + +let () = + f + (if a___________________________________________________________________ + then b_________________________________________________________________ + else c_________________________________________________________________) +;; + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition + then ( + let a = 1 in + let b = 2 in + a + b) + else if other_condition + then 12 + else 0 +;; + +let _ = + if foo + then ( + let a = 1 in + let b = 2 in + a + b) + else if foo + then 12 + else 0 +;; + +let foo = + if is_sugared_list e2 + then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) +;; + +let foo = + if is_sugared_list e2 + then Some (Semi, Non) + else + Some + ( ColonColon + , if exp == e2 + then Right + else Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo ) +;; + +let foo = + if cond1 + then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else if cond2 + then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) +;; + +let foo = + if some condition + then if some nested condition then some action else some other action + else some default action +;; + +let foo = + if some condition + then + if some nested condition + then some action + foooo + foooo + foooooooo + foooo + foooooo + else some other action + else some default action +;; + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 + then (* foo *) + a + b + else (* foo *) + a - b +;; + +let foo = + if cmp < 0 + then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 + then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) + then foo +;; + +let _ = + if fooo then ( + ) else if bar then ( * ) [@attr] else if foobar then ( / ) else ( - ) +;; + +let _ = + if x + then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz +;; + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then foooooooooooooooooooooooooooooooooooooooooo + else foooooooooooooooooooooooooooooooooooooooooo +;; + +let _ = + if + (* foo *) + foo + then 0 + else if + (* bar *) + bar + then 1 + else 2 +;; + +let compare s1 s2 = + if String.equal s1 s2 + then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options + then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options + then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 +;; + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.janestreet/ite-no_indicate.ml.err b/test/passing/refs.janestreet/ite-no_indicate.ml.err new file mode 100644 index 0000000000..7aa0928477 --- /dev/null +++ b/test/passing/refs.janestreet/ite-no_indicate.ml.err @@ -0,0 +1 @@ +Warning: ite-no_indicate.ml:37 exceeds the margin diff --git a/test/passing/refs.janestreet/ite-no_indicate.ml.ref b/test/passing/refs.janestreet/ite-no_indicate.ml.ref new file mode 100644 index 0000000000..fc3cff5ffc --- /dev/null +++ b/test/passing/refs.janestreet/ite-no_indicate.ml.ref @@ -0,0 +1,179 @@ +let _ = + if b then e + else ( + e1; + e2) +;; + +let _ = + if b then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +;; + +let _ = + if b then ( + e1; + e2) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +;; + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else e +;; + +f (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then () else ());; +f (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ());; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () + else ()) + +let () = + f + (if a___________________________________________________________________ then + b_________________________________________________________________ + else c_________________________________________________________________) +;; + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition then ( + let a = 1 in + let b = 2 in + a + b) + else if other_condition then 12 + else 0 +;; + +let _ = + if foo then ( + let a = 1 in + let b = 2 in + a + b) + else if foo then 12 + else 0 +;; + +let foo = + if is_sugared_list e2 then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) +;; + +let foo = + if is_sugared_list e2 then Some (Semi, Non) + else + Some + ( ColonColon + , if exp == e2 then Right + else Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo ) +;; + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) +;; + +let foo = + if some condition then if some nested condition then some action else some other action + else some default action +;; + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else some other action + else some default action +;; + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b +;; + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then foo +;; + +let _ = + if fooo then ( + ) else if bar then ( * ) [@attr] else if foobar then ( / ) else ( - ) +;; + +let _ = + if x then fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz +;; + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then foooooooooooooooooooooooooooooooooooooooooo + else foooooooooooooooooooooooooooooooooooooooooo +;; + +let _ = + if + (* foo *) + foo + then 0 + else if + (* bar *) + bar + then 1 + else 2 +;; + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 +;; + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.janestreet/ite-vertical.ml.ref b/test/passing/refs.janestreet/ite-vertical.ml.ref new file mode 100644 index 0000000000..a14878dc78 --- /dev/null +++ b/test/passing/refs.janestreet/ite-vertical.ml.ref @@ -0,0 +1,271 @@ +let _ = + if b then + e + else ( + e1; + e2) +;; + +let _ = + if b then + e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +;; + +let _ = + if b then ( + e1; + e2) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +;; + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else + e +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then + () + else + ()) +;; + +f + (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) +;; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () + else + ()) + +let () = + f + (if a___________________________________________________________________ then + b_________________________________________________________________ + else + c_________________________________________________________________) +;; + +let () = + if [@test] true then + () + else if [@other] true then + () +;; + +let foo = + if cond1 then + arm1 + else if cond2 then + arm2 + else + arm3 +;; + +let _ = + if condition then ( + let a = 1 in + let b = 2 in + a + b) + else if other_condition then + 12 + else + 0 +;; + +let _ = + if foo then ( + let a = 1 in + let b = 2 in + a + b) + else if foo then + 12 + else + 0 +;; + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon + , if exp == e2 then + Right + else + Left ) +;; + +let foo = + if is_sugared_list e2 then + Some (Semi, Non) + else + Some + ( ColonColon + , if exp == e2 then + Right + else + Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo ) +;; + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) +;; + +let foo = + if some condition then + if some nested condition then + some action + else + some other action + else + some default action +;; + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else + some other action + else + some default action +;; + +let foo = + if cmp < 0 then + (* foo *) + a + b + else + (* foo *) + a - b +;; + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b +;; + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo +;; + +let _ = + if fooo then + ( + ) + else if bar then + ( * ) + [@attr] + else if foobar then + ( / ) + else + ( - ) +;; + +let _ = + if x then + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else + fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz +;; + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then + foooooooooooooooooooooooooooooooooooooooooo + else + foooooooooooooooooooooooooooooooooooooooooo +;; + +let _ = + if + (* foo *) + foo + then + 0 + else if + (* bar *) + bar + then + 1 + else + 2 +;; + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 +;; + +let _ = + if x then + 42 + (* dummy *) + else + y +;; + +let _ = + if x then + 42 + (* dummy *) + else if y then + z + else + w +;; diff --git a/test/passing/refs.janestreet/ite.ml.err b/test/passing/refs.janestreet/ite.ml.err new file mode 100644 index 0000000000..ab674186a7 --- /dev/null +++ b/test/passing/refs.janestreet/ite.ml.err @@ -0,0 +1 @@ +Warning: ite.ml:37 exceeds the margin diff --git a/test/passing/refs.janestreet/ite.ml.ref b/test/passing/refs.janestreet/ite.ml.ref new file mode 100644 index 0000000000..fc3cff5ffc --- /dev/null +++ b/test/passing/refs.janestreet/ite.ml.ref @@ -0,0 +1,179 @@ +let _ = + if b then e + else ( + e1; + e2) +;; + +let _ = + if b then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +;; + +let _ = + if b then ( + e1; + e2) + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +;; + +let _ = + if b then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else if b1 then ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + else e +;; + +f (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong then () else ());; +f (if loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ());; + +f + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ()) +;; + +f + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () + else ()) + +let () = + f + (if a___________________________________________________________________ then + b_________________________________________________________________ + else c_________________________________________________________________) +;; + +let () = if [@test] true then () else if [@other] true then () +let foo = if cond1 then arm1 else if cond2 then arm2 else arm3 + +let _ = + if condition then ( + let a = 1 in + let b = 2 in + a + b) + else if other_condition then 12 + else 0 +;; + +let _ = + if foo then ( + let a = 1 in + let b = 2 in + a + b) + else if foo then 12 + else 0 +;; + +let foo = + if is_sugared_list e2 then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) +;; + +let foo = + if is_sugared_list e2 then Some (Semi, Non) + else + Some + ( ColonColon + , if exp == e2 then Right + else Left foooooo, foooo, fooo, foooooo, fooooooo, foooooooo ) +;; + +let foo = + if cond1 then ( + arm1; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else if cond2 then ( + arm2; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) + else ( + arm3; + foooooooooooooo; + fooooooooooooooooooo fooooooooooooooo foooooooooooo; + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) +;; + +let foo = + if some condition then if some nested condition then some action else some other action + else some default action +;; + +let foo = + if some condition then + if some nested condition then + some action + foooo + foooo + foooooooo + foooo + foooooo + else some other action + else some default action +;; + +let foo = if cmp < 0 then (* foo *) a + b else (* foo *) a - b + +let foo = + if cmp < 0 then (* foo *) + a + b + else (* foo *) + a - b +;; + +let foo = + if cmp < 0 then (* ast higher precedence than context: no parens *) + false + else if cmp > 0 then (* context higher prec than ast: add parens *) + true + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then foo +;; + +let _ = + if fooo then ( + ) else if bar then ( * ) [@attr] else if foobar then ( / ) else ( - ) +;; + +let _ = + if x then fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz + else fun xxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz -> + xxxxxxxxx yyyyyyyyyy zzzzzzzzzzzz +;; + +let _ = + if + (* foooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooooooooooooooooooooo + then foooooooooooooooooooooooooooooooooooooooooo + else foooooooooooooooooooooooooooooooooooooooooo +;; + +let _ = + if + (* foo *) + foo + then 0 + else if + (* bar *) + bar + then 1 + else 2 +;; + +let compare s1 s2 = + if String.equal s1 s2 then (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then (* same as above *) + -1 + else (* reverse order *) + String.compare s2 s1 +;; + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w diff --git a/test/passing/refs.janestreet/js_args.ml.ref b/test/passing/refs.janestreet/js_args.ml.ref new file mode 100644 index 0000000000..8b3befb774 --- /dev/null +++ b/test/passing/refs.janestreet/js_args.ml.ref @@ -0,0 +1,163 @@ +let () = foo.bar <- f x y z + +let should_check_can_sell_and_marking regulatory_regime = + match z with + | `foo -> some_function argument +;; + +(* The above typically occurs in a multi-pattern match clause, so the clause + expression is on a line by itself. This is the more typical way a long + single-pattern match clause would be written: *) +let should_check_can_sell_and_marking regulatory_regime = + match z with + | `foo -> some_function argument +;; + +let f = fun x -> ghi x + +(* common *) +let x = + try x with + | a -> b + | c -> d +;; + +let x = + try x with + | a -> b + | c -> d +;; + +let x = + try x with + | a -> b + | c -> d +;; + +let z = some_function argument +let () = f a b ~c d +let () = f a b ~c:1. d +let () = My_module.f a b ~c d + +(* This last case is where Tuareg is inconsistent with the others. *) +let () = My_module.f a b ~c:1. d + +let () = + messages + := Message_store.create + (Session_id.of_string "") + (* Tuareg indents these lines too far to the left. *) + "herd-retransmitter" + Message_store.Message_size.Byte +;; + +let () = + raise + (Bug + ("foo" + (* In this and similar cases, we want the subsequent lines to + align with the first expression. *) + ^ "bar")); + raise (Bug ("foo" ^ "quux" ^ "bar")); + raise (Bug ((foo + quux) ^ "bar")); + raise (Bug ((foo + quux) ^ "bar")) +;; + +(* Except in specific cases, we want the argument indented relative to the + function being called. (Exceptions include "fun" arguments where the line + ends with "->" and subsequent lines beginning with operators, like above.) *) +let () = + Some + (Message_store.create + s + "herd-retransmitter" + ~unlink:true + Message_store.Message_size.Byte) +;; + +(* We like the indentation of most arguments, but want to get back towards the + left margin in a few special cases: *) +let _ = + foo + (bar (fun x -> + (* special: "fun _ ->" at EOL *) + baz)) +;; + +(* assume no more arguments to "bar" *) + +let _ = foo ~a_long_field_name:(check (fun bar -> baz)) +let _ = foo ~a_long_field_name:(check (fun bar -> baz)) + +let _ = + foo + (bar + (quux + (fnord (fun x -> + (* any depth *) + baz)))) +;; + +(* We also wanted to tweak the operator indentation, making operators like <= + not special cases in contexts like this: *) +let _ = assert (foo (bar + baz <= quux)) +(* lined up under left argument to op, + sim. to ^ above *) + +(* Sim. indentation of if conditions: *) +let _ = if a <= b then () + +let _ = + (* Comparisons are different than conditionals; we don't regard them as + conceptually part of the [if] expression. *) + if a <= b then () +;; + +let _ = + (* We regard the outermost condition terms as conceptually part of the [if] + expression and indent accordingly. Whether [&&] or [||], conditionals + effectively state lists of conditions for [then]. *) + if + Edge_adjustment.is_zero arb.cfg.extra_edge + && 0. = sys.plugs.edge_backoff + && 0. = zero_acvol_edge_backoff + then 0. + else 1. +;; + +let _ = + if + Edge_adjustment.is_zero arb.cfg.extra_edge + && 0. = sys.plugs.edge_backoff + && 0. = zero_acvol_edge_backoff + then 0. + else 1. +;; + +let _ = + let entries = + List.filter (Lazy.force transferstati) ~f:(fun ts -> + Pcre.pmatch ~pat ts.RQ.description) + in + x +;; + +(* combination of operator at BOL and -> at EOL: *) +let _ = + Shell.ssh_lines x + |! List.map + ~f: + (f + (g (fun x -> + let name, path = String.lsplit2_exn ~on:'|' x in + String.strip name, String.strip path))) +;; + +(* open paren ending line like begin *) +let _ = + if a (p ^/ "s") [ e ] = Ok () + then + `S + (let label count = sprintf "%d s" c ^ if c = 1 then ":" else "s" in + x) +;; diff --git a/test/passing/refs.janestreet/js_begin.ml.ref b/test/passing/refs.janestreet/js_begin.ml.ref new file mode 100644 index 0000000000..6f28bc86e5 --- /dev/null +++ b/test/passing/refs.janestreet/js_begin.ml.ref @@ -0,0 +1,16 @@ +let f = function + | zoo -> + foo; + bar +;; + +let g = function + | zoo -> + foo; + bar +;; + +let () = + match foo with + | Bar -> snoo +;; diff --git a/test/passing/refs.janestreet/js_bind.ml.ref b/test/passing/refs.janestreet/js_bind.ml.ref new file mode 100644 index 0000000000..af3bee8386 --- /dev/null +++ b/test/passing/refs.janestreet/js_bind.ml.ref @@ -0,0 +1,19 @@ +let assigned_to u = + Deferred.List.filter (Request_util.requests ()) ~f:(fun request -> + if _ + then _ + else + status_request ~request () ~msg_client:no_msg + >>= fun status -> not (up_to_date_user status u)) +;; + +let old_good = foo bar qaz *>>= fun x -> hey ho lala *>>= fun y -> return (x, y) +let old_good = foo bar qaz +>>= fun x -> hey ho lala +>>= fun y -> return (x, y) + +(* generalizations based on Tuareg code *) +let old_good = + foo bar qaz + *>>| fun x -> + hey ho lala + *>>> fun y -> foo bar qaz +>>| fun x -> hey ho lala +>>> fun y -> return (x, y) +;; diff --git a/test/passing/refs.janestreet/js_fun.ml.ref b/test/passing/refs.janestreet/js_fun.ml.ref new file mode 100644 index 0000000000..a62dcc93fa --- /dev/null +++ b/test/passing/refs.janestreet/js_fun.ml.ref @@ -0,0 +1,83 @@ +(* preferred list style *) +let z = f [ y; foo ~f:(fun () -> arg) ] +let z = f [ y; foo ~f:(fun () -> arg) ] + +(* legacy list style *) +let _ = [ f (fun x -> x); f (fun x -> x); f (fun x -> x) ] +let _ = [ f (fun x -> x); f (fun x -> x); f (fun x -> x) ] +let _ = [ f (fun x -> x); f (fun x -> x); f (fun x -> x) ] + +let _ = + x + >>= fun x -> + (try x with + | _ -> ()) + >>= fun x -> + try x with + | _ -> () >>= fun x -> x +;; + +let () = + expr + >>| function + | x -> 3 + | y -> 4 +;; + +let () = + expr + >>| fun z -> + match z with + | x -> 3 + | y -> 4 +;; + +let () = + expr + >>| fun z -> function + | x -> 3 + | y -> 4 +;; + +let () = + my_func () + >>= function + | A -> 0 + | B -> 0 +;; + +let () = + my_func () + >>= function + | A -> 0 + | B -> 0 +;; + +let () = + expr + >>| function + | x -> 3 + | y -> 4 +;; + +let () = + expr + >>| function + | x -> 3 + | y -> 4 +;; + +let f = + f >>= m (fun f -> fun x -> y); + z +;; + +let f = + f |> m (fun f -> fun x -> y); + z +;; + +let f = + f |> m (fun f -> fun x -> y); + z +;; diff --git a/test/passing/refs.janestreet/js_map.ml.ref b/test/passing/refs.janestreet/js_map.ml.ref new file mode 100644 index 0000000000..db43811ff3 --- /dev/null +++ b/test/passing/refs.janestreet/js_map.ml.ref @@ -0,0 +1 @@ +let projection_files = Deferred.List.map x ~f:(fun p -> _) >>| String.split ~on:'\n' diff --git a/test/passing/refs.janestreet/js_pattern.ml.ref b/test/passing/refs.janestreet/js_pattern.ml.ref new file mode 100644 index 0000000000..6ee0bd4e0a --- /dev/null +++ b/test/passing/refs.janestreet/js_pattern.ml.ref @@ -0,0 +1,51 @@ +let f = function + | _ -> 0 +;; + +let f x = + match x with + | _ -> 0 +;; + +let f = function + | _ -> 0 +;; + +let f x = + match x with + | _ -> 0 +;; + +let f x = + match x with + | _ -> 0 +;; + +let check_price t = function + | { Exec.trade_at_settlement = None | Some false } -> () +;; + +let check_price t = function + | simpler -> () + | other -> () +;; + +(* Sometimes we like to write big alternations like this, in which case the + comment should typically align with the following clause. *) +let 0 = + match x with + | A (* a *) -> a +;; + +let 0 = + match x with + | A (* a *) -> a +;; + +let _ = + a + || + match a with + | a -> true + | b -> false +;; diff --git a/test/passing/refs.janestreet/js_poly.ml.ref b/test/passing/refs.janestreet/js_poly.ml.ref new file mode 100644 index 0000000000..cc299406a5 --- /dev/null +++ b/test/passing/refs.janestreet/js_poly.ml.ref @@ -0,0 +1,7 @@ +let handle_query qs ~msg_client:_ = + try_with (fun () -> if _ then f >>| fun () -> `Done () else _) +;; + +if _ +then _ +else assert_branch_has_node branch node >>| fun () -> { t with node; floating } diff --git a/test/passing/tests/js_record.ml.ref b/test/passing/refs.janestreet/js_record.ml.ref similarity index 100% rename from test/passing/tests/js_record.ml.ref rename to test/passing/refs.janestreet/js_record.ml.ref diff --git a/test/passing/refs.janestreet/js_sig.mli.err b/test/passing/refs.janestreet/js_sig.mli.err new file mode 100644 index 0000000000..df42bd3173 --- /dev/null +++ b/test/passing/refs.janestreet/js_sig.mli.err @@ -0,0 +1 @@ +Warning: js_sig.mli:11 exceeds the margin diff --git a/test/passing/tests/js_sig.mli.ref b/test/passing/refs.janestreet/js_sig.mli.ref similarity index 100% rename from test/passing/tests/js_sig.mli.ref rename to test/passing/refs.janestreet/js_sig.mli.ref diff --git a/test/passing/refs.janestreet/js_source.ml.err b/test/passing/refs.janestreet/js_source.ml.err new file mode 100644 index 0000000000..51f0a1a14c --- /dev/null +++ b/test/passing/refs.janestreet/js_source.ml.err @@ -0,0 +1,5 @@ +Warning: js_source.ml:10 exceeds the margin +Warning: js_source.ml:114 exceeds the margin +Warning: js_source.ml:173 exceeds the margin +Warning: js_source.ml:250 exceeds the margin +Warning: js_source.ml:748 exceeds the margin diff --git a/test/passing/refs.janestreet/js_source.ml.ref b/test/passing/refs.janestreet/js_source.ml.ref new file mode 100644 index 0000000000..0524d52b03 --- /dev/null +++ b/test/passing/refs.janestreet/js_source.ml.ref @@ -0,0 +1,989 @@ +(* Signature items *) +module type S = sig + class%foo x : t [@@foo] + + class type%foo x = x [@@foo] +end + +include struct + let%test_module "as" = + (module struct + let%expect_test "xx xx xxxxxx xxxxxxx xxxxxx xxxxxx xxxxxxxx xx xxxxx xxx xx xxxxx" = + () + ;; + end) + ;; +end +;; + +if fffffffffffffff aaaaa bb +then (if b then aaaaaaaaaaaaaaaa ffff) +else aaaaaaaaaaaa qqqqqqqqqqq + +include Base.Fn (** @open *) + +let ssmap + : (module MapT with type key = string and type data = string and type map = SSMap.map) + = + () +;; + +let ssmap + : (module MapT with type key = string and type data = string and type map = SSMap.map) + -> unit + = + () +;; + +let _ = + match x with + | A -> + [%expr + match y with + | e -> e] +;; + +let _ = + match x with + | A -> + [%expr + match y with + | e -> + (match e with + | x -> x)] +;; + +let _ = + List.map rows ~f:(fun row -> + Or_error.try_with (fun () -> fffffffffffffffffffffffff row)) +;; + +module type T = sig + (** @raise if not found. *) + val find : t -> key -> value option + + (** @param blablabla *) + val f : a_few:params -> with_long_names:to_break -> the_line:before_the_comment -> unit +end + +open! Core + +(** First documentation comment. *) +exception First_exception + +(** Second documentation comment. *) +exception Second_exception + +module M = struct + type t + [@@immediate] + (* ______________________________________ *) + [@@deriving variants, sexp_of] +end + +module type Basic3 = sig + type ('a, 'd, 'e) t + + val return : 'a -> ('a, _, _) t + val apply : ('a -> 'b, 'd, 'e) t -> ('a, 'd, 'e) t -> ('b, 'd, 'e) t + + val map + : [ `Define_using_apply + | `Custom of ('a, 'd, 'e) t -> f:('a -> 'b) -> ('b, 'd, 'e) t + ] +end + +let _ = + aa + (bbbbbbbbb + cccccccccccc + dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd) +;; + +let _ = + "_______________________________________________________ \ + _______________________________" +;; + +let _ = + [ very_long_function_name____________________ very_long_argument_name____________ ] +;; + +(* FIX: exceed 90 columns *) +let _ = + [%str + let () = very_long_function_name__________________ very_long_argument_name____________] +;; + +let _ = + { long_field_name = 9999999999999999999999999999999999999999999999999999999999999999999 + } +;; + +(* FIX: exceed 90 columns *) +let _ = + match () with + | _ -> + (match () with + | _ -> + long_function_name long_argument_name__________________________________________) +;; + +let _ = + aaaaaaa + (* __________________________________________________________________________________ *) + := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +;; + +let g = + f + ~x + (* this is a multiple-line-spanning + comment *) + ~y +;; + +let f = + very_long_function_name + ~x:very_long_variable_name + (* this is a multiple-line-spanning + comment *) + ~y +;; + +let _ = + match x with + | { y = + (* _____________________________________________________________________ *) + ( X _ | Y _ ) + } -> () +;; + +let _ = + match x with + | { y = + ( Z + (* _____________________________________________________________________ *) + | X _ + | Y _ ) + } -> () +;; + +type t = + [ `XXXX + (* __________________________________________________________________________________ *) + | `XXXX (* __________________________________________________________________ *) + | `XXXX (* _____________________________________________________ *) + | `XXXX (* ___________________________________________________ *) + | `XXXX (* ___________________________________________________ *) + | `XXXX (* ________________________________________________ *) + | `XXXX (* __________________________________________ *) + | `XXXX (* _________________________________________ *) + | `XXXX (* ______________________________________ *) + | `XXXX (* ____________________________________ *) + ] + +type t = + { field : ty + (* Here is some verbatim formatted text: + {v + starting at column 7 + v}*) + } + +module Intro_sort = struct + let foo_fooo_foooo fooo ~foooo m1 m2 m3 m4 m5 = + (* Fooooooooooooooooooooooooooo: + {v + 1--o-----o-----o--------------1 + | | | + 2--o-----|--o--|-----o--o-----2 + | | | | | + 3--------o--o--|--o--|--o-----3 + | | | + 4-----o--------o--o--|-----o--4 + | | | + 5-----o--------------o-----o--5 + v} *) + foooooooooo fooooo fooo; + foooooooooo fooooo fooo; + foooooooooo fooooo fooo + ;; +end + +let _ = + "_ _____________________ ___________ ________ _____________ ________ _____________ \ + _____\n\n\ + \ ___________________" +;; + +let nullsafe_optimistic_third_party_params_in_non_strict = + CLOpt.mk_bool + ~long:"nullsafe-optimistic-third-party-params-in-non-strict" + (* Turned on for compatibility reasons. Historically this is because + there was no actionable way to change third party annotations. Now + that we have such a support, this behavior should be reconsidered, + provided our tooling and error reporting is friendly enough to be + smoothly used by developers. *) + ~default:true + "Nullsafe: in this mode we treat non annotated third party method params as if they \ + were annotated as nullable." +;; + +let foo () = + if%bind + (* this is a medium length comment of some sort *) + this is a medium length expression of_some sort + then x + else y +;; + +let _ = + match x with + | _ + when f + ~f: + (function [@ocaml.warning (* ....................................... *) "-4"] + | _ -> .) -> y +;; + +let[@a + (* .............................................. ........................... .......................... ...................... *) + foo + (* ....................... *) + (* ................................. *) + (* ...................... *)] _ + = + match[@ocaml.warning (* ....................................... *) "-4"] + x [@attr (* .......................... .................. *) some_attr] + with + | _ + when f + ~f:(function[@ocaml.warning (* ....................................... *) "-4"] + | _ -> .) + ~f: + (function[@ocaml.warning + (* ....................................... *) + (* ....................................... *) + "foooooooooooooooooooooooooooo \ + fooooooooooooooooooooooooooooooooooooo"] + | _ -> .) + ~f: + (function[@ocaml.warning + (* ....................................... *) + let x = a + and y = b in + x + y] _ -> .) -> + y + [@attr + (* ... *) + (* ... *) + attr (* ... *)] +;; + +let x = + foo (`A b) ~f:(fun thing -> + something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping) +;; + +let x = + foo (`A `b) ~f:(fun thing -> + something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping) +;; + +let x = + foo [ A; B ] ~f:(fun thing -> + something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping) +;; + +let x = + foo [ [ A ]; B ] ~f:(fun thing -> + something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping) +;; + +let x = + f + ("A string _____________________" + ^ "Another string _____________" + ^ "Yet another string _________") +;; + +let x = + some_fun________________________________ + some_arg______________________________ + (fun param -> + do_something (); + do_something_else (); + return_this_value) +;; + +let x = + some_fun________________________________ + some_arg______________________________ + ~f:(fun param -> + do_something (); + do_something_else (); + return_this_value) +;; + +let x = + some_value + |> some_fun (fun x -> + do_something (); + do_something_else (); + return_this_value) +;; + +let x = + some_value + ^ some_fun (fun x -> + do_something (); + do_something_else (); + return_this_value) +;; + +let bind t ~f = + unfold_step + ~f:(function + | Sequence { state = seed; next }, rest -> + (match next seed with + | Done -> + (match rest with + | Sequence { state = seed; next } -> + (match next seed with + | Done -> Done + | Skip { state = s } -> + Skip { state = empty, Sequence { state = s; next } } + | Yield { value = a; state = s } -> + Skip { state = f a, Sequence { state = s; next } })) + | Skip { state = s } -> Skip { state = Sequence { state = s; next }, rest } + | Yield { value = a; state = s } -> + Yield { value = a; state = Sequence { state = s; next }, rest })) + ~init:(empty, t) +;; + +let () = + very_long_function_name + ~very_long_argument_label: + (fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> ()) +;; + +let () = + ((one_mississippi, two_mississippi, three_mississippi, four_mississippi) + : Mississippi.t * Mississippi.t * Mississippi.t * Mississippi.t) +;; + +let _ = + ((match foo with + | Bar -> bar + | Baz -> baz) + : string) +;; + +let _ = + ((match foo with + | Bar -> bar + | Baz -> baz) + :> string) +;; + +let _ = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + ~bbbbbbbbbbbbbbbbbbbbbbbbbbbb: + (fun + (_ : (ccccccccccccc * ddddddddddddddddddddddddddddd) eeee) -> FFFFFFFFF gg) + ~h +;; + +type t +[@@deriving + some_deriver_name +, another_deriver_name +, another_deriver_name +, another_deriver_name +, yet_another_such_name +, such_that_they_line_wrap] + +type t +[@@deriving + some_deriver_name + another_deriver_name + another_deriver_name + another_deriver_name + yet_another_such_name + such_that_they_line_wrap] + +let pat = + String.Search_pattern.create + (String.init len ~f:(function + | 0 -> '\n' + | n when n < len - 1 -> ' ' + | _ -> '*')) +;; + +type t = + { break_separators : [ `Before | `After ] + ; break_sequences : bool + ; break_string_literals : [ `Auto | `Never ] + (** How to potentially break string literals into new lines. *) + ; break_struct : bool + ; cases_exp_indent : int + ; cases_matching_exp_indent : [ `Normal | `Compact ] + } + +let rec collect_files + ~enable_outside_detected_project + ~root + ~segs + ~ignores + ~enables + ~files + = + match segs with + | [] | [ "" ] -> ignores, enables, files, None +;; + +let _ = + fooooooooooooooooooooooooooooooooooooooo + fooooooooooooooooooooooooooooooooooooooo + fooooooooooooooooooooooooooooooooooooooo + ~f:(fun (type a) foooooooooooooooooooooooooooooooooo : 'a -> + match fooooooooooooooooooooooooooooooooooooooo with + | Fooooooooooooooooooooooooooooooooooooooo -> x + | Fooooooooooooooooooooooooooooooooooooooo -> x) +;; + +let _ = + foo + |> List.map ~f:(fun x -> + do_something (); + do_something (); + do_something (); + do_something (); + do_something_else ()) +;; + +let _ = + foo + |> List.map ~f:(fun x -> + do_something (); + do_something (); + do_something (); + do_something (); + do_something_else ()) + |> bar +;; + +let _ = + foo + |> List.map + fooooooooooo + fooooooooooo + fooooooooooo + fooooooooooo + fooooooooooo + fooooooooooo + fooooooooooo + fooooooooooo +;; + +let _ = foo |> List.map (function A -> do_something ()) + +let _ = + foo + |> List.map (function + | A -> do_something () + | A -> do_something () + | A -> do_something () + | A -> do_something () + | A -> do_something_else ()) + |> bar +;; + +let _ = + foo + |> List.double_map + ~f1:(fun x -> + do_something (); + do_something (); + do_something (); + do_something (); + do_something_else ()) + ~f2:(fun x -> + do_something (); + do_something (); + do_something (); + do_something (); + do_something_else ()) + |> bar +;; + +module Stritem_attributes_indent : sig + val f : int -> int -> int -> int -> int + [@@cold] [@@inline never] [@@local never] [@@specialise never] + + external unsafe_memset + : t + -> pos:int + -> len:int + -> char + -> unit + = "bigstring_memset_stub" + [@@noalloc] +end = struct + let raise_length_mismatch name n1 n2 = + invalid_argf "length mismatch in %s: %d <> %d" name n1 n2 () + [@@cold] [@@inline never] [@@local never] [@@specialise never] + ;; + + external unsafe_memset + : t + -> pos:int + -> len:int + -> char + -> unit + = "bigstring_memset_stub" + [@@noalloc] +end + +let _ = + foo + $$ (match group with + | [] -> impossible "previous match" + | [ cmt ] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt) + $$ bar +;; + +let _ = + foo + $$ (try group with + | [] -> impossible "previous match" + | [ cmt ] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt) + $$ bar +;; + +let _ = + x == exp + || + match x with + | { pexp_desc = Pexp_constraint (e, _); _ } -> loop e + | _ -> false +;; + +let _ = + let module M = struct + include + (val foooooooooooooooooooooooooooooooooooooooo + : fooooooooooooooooooooooooooooooooooooooooo) + end + in + () +;; + +type action = + | In_out of [ `Impl | `Intf ] input * string option + (** Format input file (or [-] for stdin) of given kind to output file, + or stdout if None. *) + (* foo *) + | Inplace of [ `Impl | `Intf ] input list + (** Format in-place, overwriting input file(s). *) + +let%test_module "semantics" = + (module ( + struct + open Core + open Appendable_list + module Stable = Stable + end : + S)) +;; + +let _ = + Error + (`Foooooooooooooooooo + (name, Format.sprintf "expecting %S but got %S" Version.version value)) +;; + +let _ = + `Foooooooooooooooooo + (name, Format.sprintf "expecting %S but got %S" Version.version value) +;; + +let _ = + Foooooooooooooooooo + (name, Format.sprintf "expecting %S but got %S" Version.version value) +;; + +let (`Foooooooooooooooooo + (foooooooooooooo, foooooooooooooo, foooooooooooooo, foooooooooooooo)) + = + x +;; + +let (Foooooooooooooooooo + (foooooooooooooo, foooooooooooooo, foooooooooooooo, foooooooooooooo)) + = + x +;; + +let _ = + Foooooooooooooooooooo.foooooooooooooooooooo + foooooooooooooooooooo + foooooooooooooooooooo + (fun x -> function + | Foooooooooooooooooooo -> foooooooooooooooooooo + | Foooooooooooooooooooo -> foooooooooooooooooooo) +;; + +let _ = + Foooooooooooooooooooo.foooooooooooooooooooo + foooooooooooooooooooo + foooooooooooooooooooo + ~x:(fun x -> function + | Foooooooooooooooooooo -> foooooooooooooooooooo + | Foooooooooooooooooooo -> foooooooooooooooooooo) +;; + +let _ = + Foooooooooooooooooooo.foooooooooooooooooooo + foooooooooooooooooooo + foooooooooooooooooooo + (fun x -> + match foo with + | Foooooooooooooooooooo -> foooooooooooooooooooo + | Foooooooooooooooooooo -> foooooooooooooooooooo) +;; + +let _ = + Foooooooooooooooooooo.foooooooooooooooooooo + foooooooooooooooooooo + foooooooooooooooooooo + ~x:(fun x -> + match foo with + | Foooooooooooooooooooo -> foooooooooooooooooooo + | Foooooooooooooooooooo -> foooooooooooooooooooo) +;; + +let _ = + let x = x in + fun foooooooooooooooooo + foooooooooooooooooo + foooooooooooooooooo + foooooooooooooooooo + foooooooooooooooooo + foooooooooooooooooo -> () +;; + +module type For_let_syntax_local = + For_let_syntax_gen + with type ('a, 'b) fn := ('a[@local]) -> 'b + and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b + +type fooooooooooooooooooooooooooooooo = + ( fooooooooooooooooooooooooooooooo + , fooooooooooooooooooooooooooooooo ) + fooooooooooooooooooooooooooooooo + +val fooooooooooooooooooooooooooooooo + : ( fooooooooooooooooooooooooooooooo + , fooooooooooooooooooooooooooooooo ) + fooooooooooooooooooooooooooooooo + +(* *) + +(** + xxx +*) +include S1 +(** @inline *) + +type input = + { name : string + ; action : [ `Format | `Numeric of range ] + } + +let x = + fun [@foo] x -> + fun [@foo] y -> + object + method x = y + end +;; + +class x = + fun [@foo] x -> + fun [@foo] y -> + object + method x = y + end + +module M = + [%demo + module Foo = Bar + + type t] + +let _ = + Some + (fun fooooooooooooooooooooooooooooooo + fooooooooooooooooooooooooooooooo + fooooooooooooooooooooooooooooooo -> foo) +;; + +type t = + { xxxxxx : + t + (* _________________________________________________________________________ + ____________________________________________________________________ + ___________ *) + XXXXXXX.t + } + +module Test_gen + (For_tests : For_tests_gen) + (Tested : + S_gen with type 'a src := 'a For_tests.Src.t with type 'a dst := 'a For_tests.Dst.t) + (Tested : + S_gen + with type 'a src := 'a For_tests.Src.t + with type 'a dst := 'a For_tests.Dst.t + and type 'a dst := 'a For_tests.Dst.t + and type 'a dst := 'a For_tests.Dst.t) = +struct + open Tested + open For_tests +end + +type t = + { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : + YYYYYYYYYYYYYYYYYYYYY.t + (* ____________________________________ *) + } + +(*{v + + foo + +v}*) + +(*$ + {| + f|} +*) + +type t = + { xxxxxxxxxxxxxxxxxxx : yyy + [@zzzzzzzzzzzzzzzzzzz + (* ________________________________ + ___ *) + _______] + } + +let _ = + match () with + (*$ Printf.(printf "\n | _ -> .\n;;\n") *) + | _ -> . +;; + +(*$*) + +(*$ "________________________" $*) + +(*$ + let open! Core in + () +*) +(*$*) + +(*$ + [%string + {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +zzzzzzzzzzzzzzzzzzzzzzzzzzzz + |}] +*) +(*$*) + +(*$ + {| + f|} +*) + +let () = + match () with + | _ -> + (fun _ : _ -> + (match () with + | _ -> ())) + | _ -> () +;; + +(* ocp-indent-compat: Docked fun after apply only if on the same line. *) + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo +;; + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo:(fun foo -> bar) +;; + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo:(fun foo -> bar) + ~fooooooooooooooooooooooooooooooo +;; + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo:(fun foo -> + match bar with + | Some _ -> foo + | None -> baz) +;; + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo (fun foo -> bar) +;; + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo (fun foo -> + match bar with + | Some _ -> foo + | None -> baz) +;; + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo + (fun foo -> + match bar with + | Some _ -> foo + | None -> baz) +;; + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooofooooooooooooooooooooooooooooooofoooooooooo + (fun foo -> + match bar with + | Some _ -> foo + | None -> baz) +;; + +let _ = + fooooooooooooooooooooooooooooooo + |> foooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo (function foo -> bar) +;; + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo (function + | Some _ -> foo + | None -> baz) +;; + +(* *) + +(*$ (* *) *) + +(** xxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx + xxxx] xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx] *) + +(* Hand-aligned comment + . + . *) + +(* First line is indented more + . + . *) + +module type M = sig + val imported_sets_of_closures_table + : Simple_value_approx.function_declarations option + Set_of_closures_id.Tbl.fooooooooooooooooooooooooo +end + +(*$ let _ = [ x (* *); y ] *) + +let _ = + { foo = + (fun _ -> function + | _ -> + let _ = 42 in + () + | () -> ()) + } +;; + +let _ = + match () with + | _ -> + f + >>= (function + | `Fooooooooooooooooooooooooooooooooooooooo -> 1 + | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> 2) +;; + +let _ = + match () with + | _ -> + f + >>= (function + | `Fooooooooooooooooooooooooooooooooooooooo -> 1 + | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> 2) + >>= foo +;; + +let exists t key = + S.Tree.kind t.tree (path key) + >|= function + | Some `Contents -> Ok (Some `Value) + | Some `Node -> Ok (Some `Dictionary) + | None -> Ok None +;; + +let _ = if x then 42 (* dummy *) else y +let _ = if x then 42 (* dummy *) else if y then z else w + +let _ = + if x + then + fun _ -> true + (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + else f +;; + +let _ = + match ids_queue with + | Some q -> + (* this is more efficient than a linear scan of [ids] *) + fun id -> not (Ident.HashQueue.mem q id) + | None -> fun id -> not (List.mem ~equal:Ident.equal ids id) +;; + +type callbacks = + { html_debug_new_node_session_f : + 'a. + ?kind:[ `ComputePre | `ExecNode | `ExecNodeNarrowing | `WTO ] + -> pp_name:(Format.formatter -> unit) + -> Procdesc.Node.t + -> f:(unit -> 'a) + -> 'a + } diff --git a/test/passing/refs.janestreet/js_syntax.ml.ref b/test/passing/refs.janestreet/js_syntax.ml.ref new file mode 100644 index 0000000000..36f2279f6d --- /dev/null +++ b/test/passing/refs.janestreet/js_syntax.ml.ref @@ -0,0 +1,13 @@ +(* s *) + +let _ = + [%raise_structural_sexp + "feature's tip is already an ancestor of new base" + { feature_tip = (old_tip : Rev.t); new_base : Rev.t }] +;; + +let _ = + [%raise_structural_sexp + "feature's tip is already an ancestor of new base" + { feature_tip = (old_tip : Rev.t); new_base : Rev.t }] +;; diff --git a/test/passing/refs.janestreet/js_to_do.ml.ref b/test/passing/refs.janestreet/js_to_do.ml.ref new file mode 100644 index 0000000000..b74b4fad55 --- /dev/null +++ b/test/passing/refs.janestreet/js_to_do.ml.ref @@ -0,0 +1,64 @@ +(* Indentation that Jane Street needs to think about and make precise. + + These are long term ideas, possibly even conflicting with other tests. *) + +(* js-args *) + +let _ = + let min_closing_backoff = + -.(Hidden_float.expose (arb.cfg.base_edge @! Buy) + +. Hidden_float.expose (arb.cfg.base_edge @! Sell)) + in + 0 +;; + +(* js-type *) + +(* The following tests incorporate several subtle and different indentation + ideas. Please consider this only a proposal for discussion, for now. + + First, notice the display treatment of "(,)" tuples, analogous to "[;]" + lists. While "(,)" is an intensional combination of "()" and ",", unlike + "[;]" lists, we believe "(,)" isn't too big a departure. Value expression + analogies are included in js-type.ml, (meant to be) consistent with the + proposed type indentation. + + Second, and more divergently, the proposed indentation of function types is + based on the idea of aligning the arguments, even the first argument, even + where that means automatically inserting spaces within lines. This applies + to the extra spaces in ":__unit" and "(____Config.Network.t" below. + + We believe this fits into a more general incorporation of alignment into + ocp-indent, to replace our internal alignment tool with a syntax-aware one. + We like to align things for readability, like big records, record types, + lists used to build tables, etc. + + The proposal also includes indenting "->" in the circumstances below relative + to the enclosing "()", by two spaces. In a sense, this happens first, and + then the first argument is aligned accordingly. So, there's no manual + indentation or spacing below. *) + +val instances + : unit + -> ( Config.Network.t + -> (App.t * Config.instance * Config.app) list + -> verbose:bool + -> 'm + , 'm ) + Command.Spec.t + +val instances + : unit + -> ( Config.Network.t + -> (App.t * Config.instance * Config.app) list + -> verbose:bool + -> 'm + , 'm ) + Command.Spec.t + +(* presumed analog with stars *) +val instances + : unit + * ( Config.Network.t * (App.t * Config.instance * Config.app) list * bool * 'm + , 'm ) + Command.Spec.t diff --git a/test/passing/refs.janestreet/js_upon.ml.ref b/test/passing/refs.janestreet/js_upon.ml.ref new file mode 100644 index 0000000000..f386a5a53d --- /dev/null +++ b/test/passing/refs.janestreet/js_upon.ml.ref @@ -0,0 +1,16 @@ +let f x = + stop + (* We don't do this as a matter of style, but the indentation reveals a common + mistake. *) + >>> fun () -> + don't_wait_for (close fd); + bind fd +;; + +let f x = + (stop + (* This is what was intended, which is indented correctly, although it's bad + style on my part. *) + >>> fun () -> don't_wait_for (close fd)); + bind +;; diff --git a/test/passing/refs.janestreet/kw_extentions.ml.ref b/test/passing/refs.janestreet/kw_extentions.ml.ref new file mode 100644 index 0000000000..ba0d82c498 --- /dev/null +++ b/test/passing/refs.janestreet/kw_extentions.ml.ref @@ -0,0 +1,72 @@ +let _ = + let%lwt foo = Lwt.return 1 in + Lwt.return_unit +;; + +let _ = + let%lwt foo = Lwt.return 1 in + let%lwt bar = Lwt.return 1 in + let%lwt baz = Lwt.return 1 in + Lwt.return_unit +;; + +let () = + if%ext true then () else (); + if%ext true then () else if true then () else (); + let%ext x = () in + for%ext i = 1 to 10 do + () + done; + while%ext false do + () + done; + match%ext x with + | _ -> () +;; + +let () = + let%ext x = () in + try%ext x with + | _ -> () +;; + +let () = + if%ext true then () else (); + if%ext true then () else if true then () else (); + if%ext true then () else () +;; + +let () = + (match%ext x with + | _ -> ()); + match%ext x with + | _ -> () +;; + +let () = + (); + ();%ext + (); + ();%ext + () +;; + +let _ = + let%ext () = () + and () = () in + () +;; + +let () = + f (fun () -> ());%ext + f () +;; + +let () = + f (fun () -> ());%ext + g (fun () -> ()); + h (fun () -> ());%ext + i (); + j ();%ext + f () +;; diff --git a/test/passing/refs.janestreet/label_option_default_args.ml.ref b/test/passing/refs.janestreet/label_option_default_args.ml.ref new file mode 100644 index 0000000000..e22e256198 --- /dev/null +++ b/test/passing/refs.janestreet/label_option_default_args.ml.ref @@ -0,0 +1,118 @@ +let f x = e +let (* 0 *) f (* 1 *) x (* 2 *) = (* 3 *) e +let f ~x = e +let (* 0 *) f (* 1 *) ~x (* 2 *) = (* 3 *) e +let f ~(x : t) = e +let (* 0 *) f (* 1 *) ~(* 2 *) (x (* 3 *) : (* 4 *) t (* 5 *)) (* 6 *) = (* 7 *) e +let f ~l:x = e +let (* 0 *) f (* 1 *) ~l:(* 2 *) x (* 3 *) = (* 4 *) e +let f ~l:{ f; g } = e +let (* 0 *) f (* 1 *) ~l:(* 2 *) { (* 3 *) f (* 4 *); (* 5 *) g (* 6 *) } (* 7 *) = e +let f ~x:({ f; g } as x) = e +let (* 0 *) f (* 1 *) ~x:((* 2 *) { f; g } (* 3 *) as (* 4 *) x (* 5 *)) (* 6 *) = e +let f ?x = e +let (* 0 *) f (* 1 *) ?(* 2 *) x (* 3 *) = e +let f ?(x : t) = e +let (* 0 *) f (* 1 *) ?(* 2 *) (x (* 3 *) : (* 4 *) t (* 5 *)) (* 6 *) = e +let f ?l:x = e +let (* 0 *) f (* 1 *) ?l:(* 2 *) x (* 3 *) = e +let f ?l:(C x) = e + +let + (* 0 *) + f + (* 1 *) + ?l: + ((* 2 *) + (* 3 *) C (* 4 *) x (* 5 *)) + (* 6 *) + = + e +;; + +let f ?(x = d) = e +let (* 0 *) f (* 1 *) ?((* 2 *) x (* 3 *) = (* 4 *) d (* 5 *)) (* 6 *) = e +let f ?(x : t = d) = e + +let (* 0 *) f (* 1 *) ?((* 2 *) x (* 3 *) : (* 4 *) t (* 5 *) = (* 6 *) d (* 7 *)) (* 8 *) + = + e +;; + +let f ?(x = (d : t)) = e + +let + (* 0 *) + f + (* 1 *) + ?((* 2 *) x (* 3 *) = (* 4 *) ((* 5 *) d (* 6 *) : (* 7 *) t (* 8 *)) (* 9 *)) + (* 10 *) + = + e +;; + +let f ?l:(x = d) = e +let f ?l:(x = (d : t)) = e +let f ?l:(x : t = d) = e + +let + (* 0 *) + f + (* 1 *) + ?l: + ((* 2 *) + (* 3 *) + x (* 4 *) : (* 5 *) t (* 6 *) = (* 7 *) d (* 8 *)) + (* 9 *) + = + e +;; + +let f ?l:(C x = d) = e + +let + (* 0 *) + f + (* 1 *) + ?l: + ((* 2 *) + (* 3 *) + C (* 4 *) x (* 5 *) = (* 6 *) d (* 7 *)) + (* 8 *) + = + e +;; + +(* Regression tests for https://github.com/ocaml-ppx/ocamlformat/issues/1260 + (optional argument rebound to non-variable without necessary parens). *) + +(* Safe without parens *) +let f ?any:_ = () +let f ?var:a = () + +(* Requires parens *) +let f ?alias:(_ as b) = () +let f ?constant:(0) = () +let f ?interval:('a' .. 'z') = () +let f ?tuple:(1, 2) = () +let f ?construct1:(A) ?construct2:(()) ?construct3:(Some ()) = () +let f ?variant:(`A ()) = () +let f ?record:({ a; b }) = () +let f ?array:([| 1; 2; 3 |]) = () +let f ?or_:(Some () | None) = () +let f ?constraint_:(() : unit) = () +let f ?type_:(#tconst) = () +let f ?lazy_:(lazy ()) = () +let f ?extension:([%ext]) = () +let f ?open_:(Int.(zero)) = () + +(* Requires two pairs of parens *) +let f ?unpack:((module P)) = () + +(* May need extra parens to handle attributes *) +let f ?any:(_ [@attr]) = () +let f ?constant:(0 [@attr]) = () +let f ?open_:(Int.(zero) [@attr]) = () +let f ?or_:((Some () | None) [@attr]) = () +let f ?unpack:((module P) [@attr]) = () +let f ?tuple:((1, 2) [@attr]) = () diff --git a/test/passing/refs.janestreet/labelled_args-414.ml.ref b/test/passing/refs.janestreet/labelled_args-414.ml.ref new file mode 100644 index 0000000000..743b2ff484 --- /dev/null +++ b/test/passing/refs.janestreet/labelled_args-414.ml.ref @@ -0,0 +1,46 @@ +let _ = + let f ~y = y + 1 in + f ~(y : int) +;; + +let () = + very_long_function_name + ~very_long_argument_label: + (fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> ()) +;; + +let () = + very_long_function_name + ~very_long_argument_label: + (* foo *) + (fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> ()) +;; + +let () = + very_long_function_name + ~very_long_argument_label: + (fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three -> ()) + foo +;; + +let () = + very_long_function_name + ~very_long_argument_label: + (* foo *) + (fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three -> ()) + foo +;; diff --git a/test/passing/refs.janestreet/labelled_args.ml.ref b/test/passing/refs.janestreet/labelled_args.ml.ref new file mode 100644 index 0000000000..30e221324c --- /dev/null +++ b/test/passing/refs.janestreet/labelled_args.ml.ref @@ -0,0 +1,46 @@ +let _ = + let f ~y = y + 1 in + f ~y:(y : int) +;; + +let () = + very_long_function_name + ~very_long_argument_label: + (fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> ()) +;; + +let () = + very_long_function_name + ~very_long_argument_label: + (* foo *) + (fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> ()) +;; + +let () = + very_long_function_name + ~very_long_argument_label: + (fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three -> ()) + foo +;; + +let () = + very_long_function_name + ~very_long_argument_label: + (* foo *) + (fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three -> ()) + foo +;; diff --git a/test/passing/refs.janestreet/lazy.ml.ref b/test/passing/refs.janestreet/lazy.ml.ref new file mode 100644 index 0000000000..2e6dc6c125 --- /dev/null +++ b/test/passing/refs.janestreet/lazy.ml.ref @@ -0,0 +1,22 @@ +let (lazy a) = lazy 1 +let (lazy (a, b)) = lazy (1, 2) + +let () = + let (lazy a) = lazy 1 in + let (lazy (a, b)) = lazy (1, 2) in + () +;; + +let _ = lazy (a.b <- 1) + +let _ = + match x with + | (lazy (Some _ as x)), x -> x +;; + +let _ = + lazy + ((let () = () in + ()) + [@attr]) +;; diff --git a/test/passing/refs.janestreet/let_binding-deindent-fun.ml.ref b/test/passing/refs.janestreet/let_binding-deindent-fun.ml.ref new file mode 100644 index 0000000000..05b7ee881b --- /dev/null +++ b/test/passing/refs.janestreet/let_binding-deindent-fun.ml.ref @@ -0,0 +1,318 @@ +(* Note that {[ let ident : typ = exp ]} is different from {[ let (ident : + typ) = exp ]}. The difference should be maintained *) + +let (_ : int) = x1 +let (x : int) = x2 +let (_ : int) = x3 +let x : int = x4 + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + () +;; + +let%ext (_ : int) = x1 +let%ext (x : int) = x2 +let%ext (_ : int) = x3 +let%ext x : int = x4 + +let%ext _ = + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext (_ : int) = x in + () +;; + +let [%ext let x = 3] = 2 +let [%ext: [%exp let x = 3]] = 2 +let f : 'a. 'a ty -> 'a = fun y -> g y +let f (A _ | B | C) = () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ + | BBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCCCCCCCCCCCCCCCCCccccc ) + = + () +;; + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa + ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe + | FFFFFFFFFFFFFFFFFFFFFFFFFFf + | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) + | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) + = + () +;; + +let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () + +let f = function + | AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () +;; + +let f = function + | EEEEEEE | F | GGGGG | B | CCCCCCC -> () +;; + +let f = function + | EEEEEEE + | FFFFFFFFFFFFFFFFFFFFFFF + | GGGGG + | BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCC -> () +;; + +let (_ : t -> t -> int) = (compare : int list -> int list -> int) + +let _ = + let[@test] rec f = x in + y +;; + +module Let_and_compact = struct + [@@@ocamlformat "let-and=compact"] + + let x = 2 + and y = 2 + + let _ = + let x = 2 and y = 2 in + 3 + ;; + + let _ = + let%ext x = 2 and y = 2 in + 3 + ;; +end + +module Let_and_sparse = struct + [@@@ocamlformat "let-and=sparse"] + + let x = 2 + and y = 2 + + let _ = + let x = 2 + and y = 2 in + 3 + ;; + + let _ = + let%ext x = 2 + and y = 2 in + 3 + ;; +end + +let f + aaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccccc + dddddddddddddddddd + eeeeeeeeeeeeee + = + () +;; + +let _ = + fun aaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccccc + dddddddddddddddddd + eeeeeeeeeeeeee -> + () +;; + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext _ : int = x in + () +;; + +let fooo = fooooooooooo [@@foo] + +let fooo = fooooooooooo [@@foo] +and fooo = fooooooooooo [@@foo] +;; + +let foooo = fooooooooo [@@foo] in +fooooooooooooooooooooo + +let[@foo] fooo = fooooooooooo + +let[@foo] fooo = fooooooooooo +and[@foo] fooo = fooooooooooo +;; + +let[@foo] foooo = fooooooooo in +fooooooooooooooooooooo + +let a : int = 0 +let b = (0 : int) + +let _ = + let+ a = b in + c +;; + +let _ = + let+ a = b + and+ c = d in + e +;; + +let _ = + if true + then a + else + let+ a = b in + c +;; + +let _ = + if true + then + let+ a = b in + c + else d +;; + +let _ = + match a with + | a -> + (match a with + | a -> + let+ a = b in + (match a with + | a -> a)) +;; + +let _ = + match a with + | a -> + (match a with + | a -> + let+ a = b in + (match a with + | a -> a) + | b -> c) +;; + +let _ = + let+ a b = c in + d +;; + +let _ = + f + (let+ a b = c in + d) +;; + +let () = + let* x = 1 + (* blah *) + and* y = 2 in + () +;; + +let x = () +(* after x *) + +let y = () + +let x = () +(* after x *) + +and y = () + +(** doc x *) +let x = () [@@foo] +(* after x *) + +(** doc y *) +let y = () [@@foo] +(* after y *) + +(** doc x *) +let x = () +(* after x *) + +(** doc y *) +and y = () [@@foo] +(* after y *) + +let _ = + let* () = + (* xxx *) + xxx + and* () = + (* yyy *) + yyy + in + zzz +;; + +[@@@ocamlformat "let-binding-spacing=double-semicolon"] + +module A = struct + let f : int S.t ab -> float S.t ab -> string = + fun (l : int S.t ab) (r : float S.t ab) -> + match l, r with + | A, B -> "f A B" + ;; +end + +let (A (a, _, b) | B (b, a)) = A (1, 2, 3) + +let copy from ~into : unit = + let ({ pulse_captured_vars_length_contradictions + ; pulse_summaries_count + ; topl_reachable_calls + ; timeouts + ; timings + } [@warning "+9"]) + = + () + in + () +;; + +let { x; y } : foo = bar +let ({ x; y } : foo) = bar +let a, b = (raise Exit : int * int) +let a, b = (raise Exit : int * int) + +let _ = + fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> + match () with + | _ -> () +;; + +fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> + match () with + | _ -> () + +let _ + = + (* + An alternative would be to track 'mutability of the field' + directly. + *) + function + | Strict | Alias -> Immutable + | StrictOpt -> Mutable +;; diff --git a/test/passing/refs.janestreet/let_binding-in_indent.ml.ref b/test/passing/refs.janestreet/let_binding-in_indent.ml.ref new file mode 100644 index 0000000000..0452c04616 --- /dev/null +++ b/test/passing/refs.janestreet/let_binding-in_indent.ml.ref @@ -0,0 +1,318 @@ +(* Note that {[ let ident : typ = exp ]} is different from {[ let (ident : + typ) = exp ]}. The difference should be maintained *) + +let (_ : int) = x1 +let (x : int) = x2 +let (_ : int) = x3 +let x : int = x4 + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + () +;; + +let%ext (_ : int) = x1 +let%ext (x : int) = x2 +let%ext (_ : int) = x3 +let%ext x : int = x4 + +let%ext _ = + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext (_ : int) = x in + () +;; + +let [%ext let x = 3] = 2 +let [%ext: [%exp let x = 3]] = 2 +let f : 'a. 'a ty -> 'a = fun y -> g y +let f (A _ | B | C) = () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ + | BBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCCCCCCCCCCCCCCCCCccccc ) + = + () +;; + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa + ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe + | FFFFFFFFFFFFFFFFFFFFFFFFFFf + | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) + | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) + = + () +;; + +let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () + +let f = function + | AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () +;; + +let f = function + | EEEEEEE | F | GGGGG | B | CCCCCCC -> () +;; + +let f = function + | EEEEEEE + | FFFFFFFFFFFFFFFFFFFFFFF + | GGGGG + | BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCC -> () +;; + +let (_ : t -> t -> int) = (compare : int list -> int list -> int) + +let _ = + let[@test] rec f = x in + y +;; + +module Let_and_compact = struct + [@@@ocamlformat "let-and=compact"] + + let x = 2 + and y = 2 + + let _ = + let x = 2 and y = 2 in + 3 + ;; + + let _ = + let%ext x = 2 and y = 2 in + 3 + ;; +end + +module Let_and_sparse = struct + [@@@ocamlformat "let-and=sparse"] + + let x = 2 + and y = 2 + + let _ = + let x = 2 + and y = 2 in + 3 + ;; + + let _ = + let%ext x = 2 + and y = 2 in + 3 + ;; +end + +let f + aaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccccc + dddddddddddddddddd + eeeeeeeeeeeeee + = + () +;; + +let _ = + fun aaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccccc + dddddddddddddddddd + eeeeeeeeeeeeee -> + () +;; + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext _ : int = x in + () +;; + +let fooo = fooooooooooo [@@foo] + +let fooo = fooooooooooo [@@foo] +and fooo = fooooooooooo [@@foo] +;; + +let foooo = fooooooooo [@@foo] in + fooooooooooooooooooooo + +let[@foo] fooo = fooooooooooo + +let[@foo] fooo = fooooooooooo +and[@foo] fooo = fooooooooooo +;; + +let[@foo] foooo = fooooooooo in + fooooooooooooooooooooo + +let a : int = 0 +let b = (0 : int) + +let _ = + let+ a = b in + c +;; + +let _ = + let+ a = b + and+ c = d in + e +;; + +let _ = + if true + then a + else + let+ a = b in + c +;; + +let _ = + if true + then + let+ a = b in + c + else d +;; + +let _ = + match a with + | a -> + (match a with + | a -> + let+ a = b in + (match a with + | a -> a)) +;; + +let _ = + match a with + | a -> + (match a with + | a -> + let+ a = b in + (match a with + | a -> a) + | b -> c) +;; + +let _ = + let+ a b = c in + d +;; + +let _ = + f + (let+ a b = c in + d) +;; + +let () = + let* x = 1 + (* blah *) + and* y = 2 in + () +;; + +let x = () +(* after x *) + +let y = () + +let x = () +(* after x *) + +and y = () + +(** doc x *) +let x = () [@@foo] +(* after x *) + +(** doc y *) +let y = () [@@foo] +(* after y *) + +(** doc x *) +let x = () +(* after x *) + +(** doc y *) +and y = () [@@foo] +(* after y *) + +let _ = + let* () = + (* xxx *) + xxx + and* () = + (* yyy *) + yyy + in + zzz +;; + +[@@@ocamlformat "let-binding-spacing=double-semicolon"] + +module A = struct + let f : int S.t ab -> float S.t ab -> string = + fun (l : int S.t ab) (r : float S.t ab) -> + match l, r with + | A, B -> "f A B" + ;; +end + +let (A (a, _, b) | B (b, a)) = A (1, 2, 3) + +let copy from ~into : unit = + let ({ pulse_captured_vars_length_contradictions + ; pulse_summaries_count + ; topl_reachable_calls + ; timeouts + ; timings + } [@warning "+9"]) + = + () + in + () +;; + +let { x; y } : foo = bar +let ({ x; y } : foo) = bar +let a, b = (raise Exit : int * int) +let a, b = (raise Exit : int * int) + +let _ = + fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> + match () with + | _ -> () +;; + +fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> + match () with + | _ -> () + +let _ + = + (* + An alternative would be to track 'mutability of the field' + directly. + *) + function + | Strict | Alias -> Immutable + | StrictOpt -> Mutable +;; diff --git a/test/passing/refs.janestreet/let_binding-indent.ml.ref b/test/passing/refs.janestreet/let_binding-indent.ml.ref new file mode 100644 index 0000000000..f47f152938 --- /dev/null +++ b/test/passing/refs.janestreet/let_binding-indent.ml.ref @@ -0,0 +1,318 @@ +(* Note that {[ let ident : typ = exp ]} is different from {[ let (ident : + typ) = exp ]}. The difference should be maintained *) + +let (_ : int) = x1 +let (x : int) = x2 +let (_ : int) = x3 +let x : int = x4 + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + () +;; + +let%ext (_ : int) = x1 +let%ext (x : int) = x2 +let%ext (_ : int) = x3 +let%ext x : int = x4 + +let%ext _ = + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext (_ : int) = x in + () +;; + +let [%ext let x = 3] = 2 +let [%ext: [%exp let x = 3]] = 2 +let f : 'a. 'a ty -> 'a = fun y -> g y +let f (A _ | B | C) = () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ + | BBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCCCCCCCCCCCCCCCCCccccc ) + = + () +;; + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa + ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe + | FFFFFFFFFFFFFFFFFFFFFFFFFFf + | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) + | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) + = + () +;; + +let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () + +let f = function + | AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () +;; + +let f = function + | EEEEEEE | F | GGGGG | B | CCCCCCC -> () +;; + +let f = function + | EEEEEEE + | FFFFFFFFFFFFFFFFFFFFFFF + | GGGGG + | BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCC -> () +;; + +let (_ : t -> t -> int) = (compare : int list -> int list -> int) + +let _ = + let[@test] rec f = x in + y +;; + +module Let_and_compact = struct + [@@@ocamlformat "let-and=compact"] + + let x = 2 + and y = 2 + + let _ = + let x = 2 and y = 2 in + 3 + ;; + + let _ = + let%ext x = 2 and y = 2 in + 3 + ;; +end + +module Let_and_sparse = struct + [@@@ocamlformat "let-and=sparse"] + + let x = 2 + and y = 2 + + let _ = + let x = 2 + and y = 2 in + 3 + ;; + + let _ = + let%ext x = 2 + and y = 2 in + 3 + ;; +end + +let f + aaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccccc + dddddddddddddddddd + eeeeeeeeeeeeee + = + () +;; + +let _ = + fun aaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccccc + dddddddddddddddddd + eeeeeeeeeeeeee -> + () +;; + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext _ : int = x in + () +;; + +let fooo = fooooooooooo [@@foo] + +let fooo = fooooooooooo [@@foo] +and fooo = fooooooooooo [@@foo] +;; + +let foooo = fooooooooo [@@foo] in +fooooooooooooooooooooo + +let[@foo] fooo = fooooooooooo + +let[@foo] fooo = fooooooooooo +and[@foo] fooo = fooooooooooo +;; + +let[@foo] foooo = fooooooooo in +fooooooooooooooooooooo + +let a : int = 0 +let b = (0 : int) + +let _ = + let+ a = b in + c +;; + +let _ = + let+ a = b + and+ c = d in + e +;; + +let _ = + if true + then a + else + let+ a = b in + c +;; + +let _ = + if true + then + let+ a = b in + c + else d +;; + +let _ = + match a with + | a -> + (match a with + | a -> + let+ a = b in + (match a with + | a -> a)) +;; + +let _ = + match a with + | a -> + (match a with + | a -> + let+ a = b in + (match a with + | a -> a) + | b -> c) +;; + +let _ = + let+ a b = c in + d +;; + +let _ = + f + (let+ a b = c in + d) +;; + +let () = + let* x = 1 + (* blah *) + and* y = 2 in + () +;; + +let x = () +(* after x *) + +let y = () + +let x = () +(* after x *) + +and y = () + +(** doc x *) +let x = () [@@foo] +(* after x *) + +(** doc y *) +let y = () [@@foo] +(* after y *) + +(** doc x *) +let x = () +(* after x *) + +(** doc y *) +and y = () [@@foo] +(* after y *) + +let _ = + let* () = + (* xxx *) + xxx + and* () = + (* yyy *) + yyy + in + zzz +;; + +[@@@ocamlformat "let-binding-spacing=double-semicolon"] + +module A = struct + let f : int S.t ab -> float S.t ab -> string = + fun (l : int S.t ab) (r : float S.t ab) -> + match l, r with + | A, B -> "f A B" + ;; +end + +let (A (a, _, b) | B (b, a)) = A (1, 2, 3) + +let copy from ~into : unit = + let ({ pulse_captured_vars_length_contradictions + ; pulse_summaries_count + ; topl_reachable_calls + ; timeouts + ; timings + } [@warning "+9"]) + = + () + in + () +;; + +let { x; y } : foo = bar +let ({ x; y } : foo) = bar +let a, b = (raise Exit : int * int) +let a, b = (raise Exit : int * int) + +let _ = + fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> + match () with + | _ -> () +;; + +fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> + match () with + | _ -> () + +let _ + = + (* + An alternative would be to track 'mutability of the field' + directly. + *) + function + | Strict | Alias -> Immutable + | StrictOpt -> Mutable +;; diff --git a/test/passing/refs.janestreet/let_binding.ml.ref b/test/passing/refs.janestreet/let_binding.ml.ref new file mode 100644 index 0000000000..05b7ee881b --- /dev/null +++ b/test/passing/refs.janestreet/let_binding.ml.ref @@ -0,0 +1,318 @@ +(* Note that {[ let ident : typ = exp ]} is different from {[ let (ident : + typ) = exp ]}. The difference should be maintained *) + +let (_ : int) = x1 +let (x : int) = x2 +let (_ : int) = x3 +let x : int = x4 + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + () +;; + +let%ext (_ : int) = x1 +let%ext (x : int) = x2 +let%ext (_ : int) = x3 +let%ext x : int = x4 + +let%ext _ = + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext (_ : int) = x in + () +;; + +let [%ext let x = 3] = 2 +let [%ext: [%exp let x = 3]] = 2 +let f : 'a. 'a ty -> 'a = fun y -> g y +let f (A _ | B | C) = () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ + | BBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCCCCCCCCCCCCCCCCCccccc ) + = + () +;; + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa + ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe + | FFFFFFFFFFFFFFFFFFFFFFFFFFf + | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) + | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) + = + () +;; + +let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () + +let f = function + | AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () +;; + +let f = function + | EEEEEEE | F | GGGGG | B | CCCCCCC -> () +;; + +let f = function + | EEEEEEE + | FFFFFFFFFFFFFFFFFFFFFFF + | GGGGG + | BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCC -> () +;; + +let (_ : t -> t -> int) = (compare : int list -> int list -> int) + +let _ = + let[@test] rec f = x in + y +;; + +module Let_and_compact = struct + [@@@ocamlformat "let-and=compact"] + + let x = 2 + and y = 2 + + let _ = + let x = 2 and y = 2 in + 3 + ;; + + let _ = + let%ext x = 2 and y = 2 in + 3 + ;; +end + +module Let_and_sparse = struct + [@@@ocamlformat "let-and=sparse"] + + let x = 2 + and y = 2 + + let _ = + let x = 2 + and y = 2 in + 3 + ;; + + let _ = + let%ext x = 2 + and y = 2 in + 3 + ;; +end + +let f + aaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccccc + dddddddddddddddddd + eeeeeeeeeeeeee + = + () +;; + +let _ = + fun aaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccccc + dddddddddddddddddd + eeeeeeeeeeeeee -> + () +;; + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext _ : int = x in + () +;; + +let fooo = fooooooooooo [@@foo] + +let fooo = fooooooooooo [@@foo] +and fooo = fooooooooooo [@@foo] +;; + +let foooo = fooooooooo [@@foo] in +fooooooooooooooooooooo + +let[@foo] fooo = fooooooooooo + +let[@foo] fooo = fooooooooooo +and[@foo] fooo = fooooooooooo +;; + +let[@foo] foooo = fooooooooo in +fooooooooooooooooooooo + +let a : int = 0 +let b = (0 : int) + +let _ = + let+ a = b in + c +;; + +let _ = + let+ a = b + and+ c = d in + e +;; + +let _ = + if true + then a + else + let+ a = b in + c +;; + +let _ = + if true + then + let+ a = b in + c + else d +;; + +let _ = + match a with + | a -> + (match a with + | a -> + let+ a = b in + (match a with + | a -> a)) +;; + +let _ = + match a with + | a -> + (match a with + | a -> + let+ a = b in + (match a with + | a -> a) + | b -> c) +;; + +let _ = + let+ a b = c in + d +;; + +let _ = + f + (let+ a b = c in + d) +;; + +let () = + let* x = 1 + (* blah *) + and* y = 2 in + () +;; + +let x = () +(* after x *) + +let y = () + +let x = () +(* after x *) + +and y = () + +(** doc x *) +let x = () [@@foo] +(* after x *) + +(** doc y *) +let y = () [@@foo] +(* after y *) + +(** doc x *) +let x = () +(* after x *) + +(** doc y *) +and y = () [@@foo] +(* after y *) + +let _ = + let* () = + (* xxx *) + xxx + and* () = + (* yyy *) + yyy + in + zzz +;; + +[@@@ocamlformat "let-binding-spacing=double-semicolon"] + +module A = struct + let f : int S.t ab -> float S.t ab -> string = + fun (l : int S.t ab) (r : float S.t ab) -> + match l, r with + | A, B -> "f A B" + ;; +end + +let (A (a, _, b) | B (b, a)) = A (1, 2, 3) + +let copy from ~into : unit = + let ({ pulse_captured_vars_length_contradictions + ; pulse_summaries_count + ; topl_reachable_calls + ; timeouts + ; timings + } [@warning "+9"]) + = + () + in + () +;; + +let { x; y } : foo = bar +let ({ x; y } : foo) = bar +let a, b = (raise Exit : int * int) +let a, b = (raise Exit : int * int) + +let _ = + fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> + match () with + | _ -> () +;; + +fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> + match () with + | _ -> () + +let _ + = + (* + An alternative would be to track 'mutability of the field' + directly. + *) + function + | Strict | Alias -> Immutable + | StrictOpt -> Mutable +;; diff --git a/test/passing/refs.janestreet/let_binding_spacing-double-semicolon.ml.ref b/test/passing/refs.janestreet/let_binding_spacing-double-semicolon.ml.ref new file mode 100644 index 0000000000..2cba37f028 --- /dev/null +++ b/test/passing/refs.janestreet/let_binding_spacing-double-semicolon.ml.ref @@ -0,0 +1,10 @@ +let f x = x +and g x = x + +let f x = x +and g : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = fun h a b -> h +and g : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = fun h a b -> h (i a) (i b) (i c) + +let f x = x +let f : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = fun h a b -> h (i a) (i b) (i c) +let f x = x diff --git a/test/passing/refs.janestreet/let_binding_spacing-sparse.ml.ref b/test/passing/refs.janestreet/let_binding_spacing-sparse.ml.ref new file mode 100644 index 0000000000..2cba37f028 --- /dev/null +++ b/test/passing/refs.janestreet/let_binding_spacing-sparse.ml.ref @@ -0,0 +1,10 @@ +let f x = x +and g x = x + +let f x = x +and g : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = fun h a b -> h +and g : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = fun h a b -> h (i a) (i b) (i c) + +let f x = x +let f : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = fun h a b -> h (i a) (i b) (i c) +let f x = x diff --git a/test/passing/refs.janestreet/let_binding_spacing.ml.ref b/test/passing/refs.janestreet/let_binding_spacing.ml.ref new file mode 100644 index 0000000000..2cba37f028 --- /dev/null +++ b/test/passing/refs.janestreet/let_binding_spacing.ml.ref @@ -0,0 +1,10 @@ +let f x = x +and g x = x + +let f x = x +and g : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = fun h a b -> h +and g : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = fun h a b -> h (i a) (i b) (i c) + +let f x = x +let f : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = fun h a b -> h (i a) (i b) (i c) +let f x = x diff --git a/test/passing/refs.janestreet/let_in_constr.ml.ref b/test/passing/refs.janestreet/let_in_constr.ml.ref new file mode 100644 index 0000000000..8c0aeccc4f --- /dev/null +++ b/test/passing/refs.janestreet/let_in_constr.ml.ref @@ -0,0 +1,5 @@ +let _ = + Some + (let open! List in + 1) +;; diff --git a/test/passing/refs.janestreet/let_module-sparse.ml.ref b/test/passing/refs.janestreet/let_module-sparse.ml.ref new file mode 100644 index 0000000000..d54fb5bdab --- /dev/null +++ b/test/passing/refs.janestreet/let_module-sparse.ml.ref @@ -0,0 +1,80 @@ +let () = + let module X = + Map.Make (struct + type t = t + + let compare = compare + end) + in + foo +;; + +let () = + let module X = + Map.Make (struct + type t = t + end) + [@foo] + in + let module K = Foooooooooo in + (* foooooo *) + let module X = + Map.Make (struct + type t = t (* foooooooooo *) + end) + [@foo] + in + let module T = X [@foo] in + let module X = + Fooo (struct + type t = t + end) + in + foo +;; + +let () = + let module X = + Map.Make + (struct + type t = t + end) + (* foooooooooooooo *) + (struct + type t = t + type t = t + type t = t + type t = t + end) + (struct + type t = t + type t = t + end) + in + foo +;; + +let f () = + let module (* comment *) M = struct end in + () +;; + +let f () = + let module + (* comment *) + M = + struct end + in + () +;; + +let f () = + let module + (* multi-line + + comment *) + M = + struct end + in + () +;; diff --git a/test/passing/refs.janestreet/let_module.ml.ref b/test/passing/refs.janestreet/let_module.ml.ref new file mode 100644 index 0000000000..02b3a92425 --- /dev/null +++ b/test/passing/refs.janestreet/let_module.ml.ref @@ -0,0 +1,76 @@ +let () = + let module X = Map.Make (struct + type t = t + + let compare = compare + end) + in + foo +;; + +let () = + let module X = Map.Make (struct + type t = t + end) + [@foo] + in + let module K = Foooooooooo in + (* foooooo *) + let module X = Map.Make (struct + type t = t (* foooooooooo *) + end) + [@foo] + in + let module T = X [@foo] in + let module X = Fooo (struct + type t = t + end) + in + foo +;; + +let () = + let module X = + Map.Make + (struct + type t = t + end) + (* foooooooooooooo *) + (struct + type t = t + type t = t + type t = t + type t = t + end) + (struct + type t = t + type t = t + end) + in + foo +;; + +let f () = + let module (* comment *) M = struct end in + () +;; + +let f () = + let module + (* comment *) + M = + struct end + in + () +;; + +let f () = + let module + (* multi-line + + comment *) + M = + struct end + in + () +;; diff --git a/test/passing/refs.janestreet/let_punning.ml.ref b/test/passing/refs.janestreet/let_punning.ml.ref new file mode 100644 index 0000000000..c0b6525856 --- /dev/null +++ b/test/passing/refs.janestreet/let_punning.ml.ref @@ -0,0 +1,20 @@ +let ( let* ) x f = f x +let ( and* ) a b = a, b + +let x = 1 +and y = 2 +and z = 3 + +let p = + let* x = x + and* y = y + and* z = z in + x, y, z +;; + +let q = + let%foo x = x + and y = y + and z = z in + x, y, z +;; diff --git a/test/passing/refs.janestreet/line_directives.ml.err b/test/passing/refs.janestreet/line_directives.ml.err new file mode 100644 index 0000000000..45382a4f00 --- /dev/null +++ b/test/passing/refs.janestreet/line_directives.ml.err @@ -0,0 +1,5 @@ +ocamlformat: ignoring "line_directives.ml" (syntax error) +File "line_directives.ml", line 1, characters 1-9: +1 | #3 "f.ml" + ^^^^^^^^ +Error: Invalid lexer directive "#3 \"f.ml\"": line directives are not supported diff --git a/test/passing/refs.janestreet/list-space_around.ml.ref b/test/passing/refs.janestreet/list-space_around.ml.ref new file mode 100644 index 0000000000..f130d6b736 --- /dev/null +++ b/test/passing/refs.janestreet/list-space_around.ml.ref @@ -0,0 +1,106 @@ +let f x = + match x with + | P ({ xxxxxx } :: { yyyyyyyy } :: zzzzzzz) -> true +;; + +let f x = + match x with + | P + ({ xxxxxxxxxxxxxxxxxxxxxx } + :: { yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy } + :: zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz) -> true +;; + +let f x = + match x with + | P [ { xxxxxx }; { yyyyyyyy } ] -> true +;; + +let x = (x :: y) :: z + +let x = + match x with + | (x :: y) :: z -> () +;; + +let _ = [ a; b; c ] + +let _ = + match x with + | Atom x -> x + | List [ Atom x; Atom y ] -> x ^ y +;; + +let _ = + match x with + | Atom x -> x + | List (Atom x :: Atom y :: rest) -> x ^ y +;; + +let _ = + match x with + | (x :: y) :: z -> true +;; + +let x = function + | [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" + ; [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" + ; (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *) + ] + ; (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *) + ] -> () +;; + +[@@@ocamlformat "space-around-lists=true"] + +let x = function + | [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" + ; [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" + ; (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *) + ] + ; (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *) + ] -> () + | [ [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" ] + ; (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *) + ] -> () +;; + +let _ = f (* A *) ~x:(a :: b) (* B *) ~y +let _ = f (* A *) ~x:((* B *) a :: b (* C *)) (* D *) ~y +let _ = f ~x:((* A *) a (* B *) :: (* C *) b (* D *) :: (* E *) c (* F *)) ~y +let _ = f ((* A *) x (* B *) :: (* C *) y (* D *) :: (* E *) z (* F *)) +let _ = abc :: (* def :: *) ghi :: jkl +let _ = abc :: def (* :: ghi *) :: jkl +let _ = (c :: l1) @ foo (l2 @ l) + +let _ = + make_single_trace create_loc message + :: make_single_trace create_loc create_message + :: List.map call_chain ~f:(fun foooooooooooooooooooooooooooo -> + fooooooooooooooooooooooooooooooo foooooooooooo []) + :: foooooooo + :: fooooooooooooooooo +;; + +let _ = + fooooooo + (mk_var i (tfo_combine (nuc_p_o3'_60_tfo n) align) n + :: mk_var i (tfo_combine (nuc_p_o3'_180_tfo n) align) n + :: mk_var i (tfo_combine (nuc_p_o3'_275_tfo n) align) n + :: domains) +;; diff --git a/test/passing/refs.janestreet/list.ml.ref b/test/passing/refs.janestreet/list.ml.ref new file mode 100644 index 0000000000..f130d6b736 --- /dev/null +++ b/test/passing/refs.janestreet/list.ml.ref @@ -0,0 +1,106 @@ +let f x = + match x with + | P ({ xxxxxx } :: { yyyyyyyy } :: zzzzzzz) -> true +;; + +let f x = + match x with + | P + ({ xxxxxxxxxxxxxxxxxxxxxx } + :: { yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy } + :: zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz) -> true +;; + +let f x = + match x with + | P [ { xxxxxx }; { yyyyyyyy } ] -> true +;; + +let x = (x :: y) :: z + +let x = + match x with + | (x :: y) :: z -> () +;; + +let _ = [ a; b; c ] + +let _ = + match x with + | Atom x -> x + | List [ Atom x; Atom y ] -> x ^ y +;; + +let _ = + match x with + | Atom x -> x + | List (Atom x :: Atom y :: rest) -> x ^ y +;; + +let _ = + match x with + | (x :: y) :: z -> true +;; + +let x = function + | [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" + ; [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" + ; (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *) + ] + ; (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *) + ] -> () +;; + +[@@@ocamlformat "space-around-lists=true"] + +let x = function + | [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" + ; [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" + ; (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *) + ] + ; (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *) + ] -> () + | [ [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" ] + ; (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *) + ] -> () +;; + +let _ = f (* A *) ~x:(a :: b) (* B *) ~y +let _ = f (* A *) ~x:((* B *) a :: b (* C *)) (* D *) ~y +let _ = f ~x:((* A *) a (* B *) :: (* C *) b (* D *) :: (* E *) c (* F *)) ~y +let _ = f ((* A *) x (* B *) :: (* C *) y (* D *) :: (* E *) z (* F *)) +let _ = abc :: (* def :: *) ghi :: jkl +let _ = abc :: def (* :: ghi *) :: jkl +let _ = (c :: l1) @ foo (l2 @ l) + +let _ = + make_single_trace create_loc message + :: make_single_trace create_loc create_message + :: List.map call_chain ~f:(fun foooooooooooooooooooooooooooo -> + fooooooooooooooooooooooooooooooo foooooooooooo []) + :: foooooooo + :: fooooooooooooooooo +;; + +let _ = + fooooooo + (mk_var i (tfo_combine (nuc_p_o3'_60_tfo n) align) n + :: mk_var i (tfo_combine (nuc_p_o3'_180_tfo n) align) n + :: mk_var i (tfo_combine (nuc_p_o3'_275_tfo n) align) n + :: domains) +;; diff --git a/test/passing/refs.janestreet/list_and_comments.ml.ref b/test/passing/refs.janestreet/list_and_comments.ml.ref new file mode 100644 index 0000000000..172912090b --- /dev/null +++ b/test/passing/refs.janestreet/list_and_comments.ml.ref @@ -0,0 +1 @@ +[ 1; (* one *) 2 (* two *) ] diff --git a/test/passing/refs.janestreet/list_normalized.ml.ref b/test/passing/refs.janestreet/list_normalized.ml.ref new file mode 100644 index 0000000000..dac93cb3cc --- /dev/null +++ b/test/passing/refs.janestreet/list_normalized.ml.ref @@ -0,0 +1,56 @@ +let x = [ 1; 2; 3; 4 ] + +(* comments may move during normalization *) +let x = + (* a *) + [ 1 (* b *) + ; (* c *) + 2 + ; 3 + ; 4 + (* d *) + (* e *) + ] +;; + +(* f *) + +(* comments preserved when the normalization cannot be done (attributes) *) +let x = (* a *) 1 (* b *) :: (* c *) 2 :: 3 :: 4 (* d *) :: (* e *) ([] [@attr]) (* f *) + +(* comments preserved when no normalization required *) +let x = (* a *) [ (* b *) 1 (* c *); (* d *) 2; 3; 4 (* e *) ] (* f *) +let (x :: []) = e +let (x :: y) = e +let [ x; y ] = e +let (x :: y :: ([] [@attr])) = e +let [ x; (y [@attr]) ] = e +let (*a*) (x (*b*) :: (*c*) y (*d*)) = e + +let + (*a*) + [ x (*b*) + ; (*c*) + y + (*d*) + (*e*) + ] + (*f*) + = + e +;; + +let (*a*) (x (*b*) :: (*c*) y (*d*) :: (*e*) ([] [@attr])) (*f*) = e + +let + (*a*) + [ x (*b*) + ; (*c*) + (y [@attr]) + (*d*) + (*e*) + ] + (*f*) + = + e +;; diff --git a/test/passing/refs.janestreet/loc_stack.ml.ref b/test/passing/refs.janestreet/loc_stack.ml.ref new file mode 100644 index 0000000000..66e89a8c72 --- /dev/null +++ b/test/passing/refs.janestreet/loc_stack.ml.ref @@ -0,0 +1,47 @@ +let _ = + (* a *) + (* b *) + 2 +;; + +let _ = + (* before match *) + match (* after match *) x with + | _ -> 1 +;; + +let _ = + (* before try *) + try (* after try *) x with + | _ -> 1 +;; + +let should_inline : Llvm.llvalue -> bool = + fun llv -> + match Llvm.use_begin llv with + | Some use -> + (match Llvm.use_succ use with + | Some _ -> + (* If we are not in the default context, we can only use the OCAMLPATH + variable if it is specific to this build context *) + (* CR-someday diml: maybe we should actually clear OCAMLPATH in other + build contexts *) + (match Llvm.classify_value llv with + | Instruction + ( Trunc + | ZExt + | SExt + | FPToUI + | FPToSI + | UIToFP + | SIToFP + | FPTrunc + | FPExt + | PtrToInt + | IntToPtr + | BitCast + | AddrSpaceCast ) -> true (* inline casts *) + | _ -> false (* do not inline if >= 2 uses *)) + | None -> true) + | None -> true +;; diff --git a/test/passing/refs.janestreet/locally_abtract_types.ml.ref b/test/passing/refs.janestreet/locally_abtract_types.ml.ref new file mode 100644 index 0000000000..b46e5cd3cc --- /dev/null +++ b/test/passing/refs.janestreet/locally_abtract_types.ml.ref @@ -0,0 +1,14 @@ +let f (type v) (x : v) = x +let f (type v) (x : v) : unit = () + +let f : type s. s t -> s = function + | X x -> x + | Y y -> y +;; + +let x = (fun (type a) x -> x) () +let x = (fun x (type a b c) x -> x) () + +let f = function + | T x -> (fun (type a) (x : a t) -> x) x +;; diff --git a/test/passing/refs.janestreet/margin_80.ml.ref b/test/passing/refs.janestreet/margin_80.ml.ref new file mode 100644 index 0000000000..62f93af4f8 --- /dev/null +++ b/test/passing/refs.janestreet/margin_80.ml.ref @@ -0,0 +1,33 @@ +type t = + ([ `foo + | `bar (** 58 chars.................................................. *) + ] + [@js.enum]) + +let _ = + aa + (bbbbbbbbb + cccccccccccc + dddddddddddddddddddddddddddddddddddddddddddddddddddd) +;; + +let _ = + aa + (bbbbbbbbb + cccccccccccc + dddddddddddddddddddddddddddddddddddddd [@dddddddddd]) +;; + +let _ = + aa + (bbbbbbbbb + cccccccccccc + ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd + [@dddddddddd]) +;; + +let _ = + aa + (bbbbbbbbb cccccccccccc dddddddddddddddddddddddddddddddddddddd) + [@dddddddddd] +;; diff --git a/test/passing/refs.janestreet/match.ml.ref b/test/passing/refs.janestreet/match.ml.ref new file mode 100644 index 0000000000..cd4ee360c0 --- /dev/null +++ b/test/passing/refs.janestreet/match.ml.ref @@ -0,0 +1,108 @@ +let _ = + match a with + | A -> + (match b with + | B -> b + | C -> c) + | D -> D +;; + +let _ = + match a with + | AAAAAAAAAA -> + (match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> ccccccccccccccccc) + | DDDDDDDDDDDDDDd -> DDDDDDDDDDDDDDDDdD +;; + +let _ = + match a with + | AAAAAAAAAA -> + let x = 3 in + (match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> ccccccccccccccccc) + | DDDDDDDDDDDDDDd -> DDDDDDDDDDDDDDDDdD +;; + +let _ = + match x with + | _ -> + (match + something + long + enough + to_break + _________________________________________________________________ + with + | AAAAAAAAAA -> + let x = 3 in + (match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> ccccccccccccccccc) + | DDDDDDDDDDDDDDd -> DDDDDDDDDDDDDDDDdD) +;; + +let x = + let g = + match x with + | `A -> + (fun id -> function + | A -> + e; + e + | _ -> ()) + | `B -> + (fun id -> function + | A -> + e; + e + | _ -> ()) + in + () +;; + +let x = + let g = + match x with + | `A -> + (fun id -> function + | A -> () + | B -> ()) + | `B -> + (fun id -> function + | A -> () + | _ -> ()) + in + () +;; + +let x = + let g = + match x with + | `A -> + (function + | A -> () + | B -> ()) + | `B -> + (function + | A -> () + | _ -> ()) + in + () +;; + +let x = + let g = + match x with + | `A -> fun (A | B) -> () + | `B -> fun (A | _) -> () + in + () +;; + +let _ = + match x with + | _ -> b >>= fun () -> c +;; diff --git a/test/passing/refs.janestreet/match2.ml.ref b/test/passing/refs.janestreet/match2.ml.ref new file mode 100644 index 0000000000..a628ccfe5f --- /dev/null +++ b/test/passing/refs.janestreet/match2.ml.ref @@ -0,0 +1,143 @@ +let _ = + match a with + | A -> + (match b with + | B -> b + | C -> c) + | D -> D +;; + +let _ = + match a with + | AAAAAAAAAA -> + (match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> ccccccccccccccccc) + | DDDDDDDDDDDDDDd -> DDDDDDDDDDDDDDDDdD +;; + +let _ = + match a with + | AAAAAAAAAA -> + let x = 3 in + (match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> ccccccccccccccccc) + | DDDDDDDDDDDDDDd -> DDDDDDDDDDDDDDDDdD +;; + +let _ = + match x with + | _ -> + (match + something + long + enough + to_break + _________________________________________________________________ + with + | AAAAAAAAAA -> + let x = 3 in + (match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> ccccccccccccccccc) + | DDDDDDDDDDDDDDd -> DDDDDDDDDDDDDDDDdD) +;; + +let x = + let g = + match x with + | `A -> + fun id -> + (function + | A -> () + | B -> ()) + | `B -> + fun id -> + (function + | A -> () + | _ -> ()) + in + () +;; + +let x = + let g = + match x with + | `A -> + (function + | A -> () + | B -> ()) + | `B -> + (function + | A -> () + | _ -> ()) + in + () +;; + +let x = + let g = + match x with + | `A -> fun (A | B) -> () + | `B -> fun (A | _) -> () + in + () +;; + +let _ = + match x with + | _ -> b >>= fun () -> c +;; + +[@@@ocamlformat "break-infix-before-func=false"] + +let foo = + match foo with + | 1 -> + bar >>= ( function + | _ -> () ) + | other -> () +;; + +let foo = + match foo with + | 1 -> + bar >>= ( function + | a -> fooooo + | b -> fooooo + | _ -> () ) + | other -> () +;; + +let foo = + match foo with + | 1 -> + bar >>= ( function + | a -> fooooo + | b -> fooooo + | c -> foooooooo foooooooooo fooooooooooooooooooo () + | _ -> () ) + | other -> () +;; + +let _ = + match a with + | a -> + (match a with + | a -> + let+ a = b in + (match a with + | a -> a)) +;; + +let _ = + match a with + | a -> + (match a with + | a -> + let+ a = b in + (match a with + | a -> a) + | b -> c) +;; diff --git a/test/passing/refs.janestreet/match_indent-never.ml.ref b/test/passing/refs.janestreet/match_indent-never.ml.ref new file mode 100644 index 0000000000..bcc3767575 --- /dev/null +++ b/test/passing/refs.janestreet/match_indent-never.ml.ref @@ -0,0 +1,22 @@ +match fooooooooooooooooooooooo with +| fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + +let foooooooo = + match fooooooooooooooooooooooo with + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo +;; + +let foooooooo = + try fooooooooooooooooooooooo with + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo +;; + +let fooooo = + if foooooooo + then ( + match fooooooooooooooooooooooo with + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo) + else foooooooo +;; diff --git a/test/passing/refs.janestreet/match_indent.ml.ref b/test/passing/refs.janestreet/match_indent.ml.ref new file mode 100644 index 0000000000..bcc3767575 --- /dev/null +++ b/test/passing/refs.janestreet/match_indent.ml.ref @@ -0,0 +1,22 @@ +match fooooooooooooooooooooooo with +| fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + +let foooooooo = + match fooooooooooooooooooooooo with + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo +;; + +let foooooooo = + try fooooooooooooooooooooooo with + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo +;; + +let fooooo = + if foooooooo + then ( + match fooooooooooooooooooooooo with + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> foooooooooooooooooooooooooo) + else foooooooo +;; diff --git a/test/passing/refs.janestreet/max_indent.ml.err b/test/passing/refs.janestreet/max_indent.ml.err new file mode 100644 index 0000000000..2d1d2dca13 --- /dev/null +++ b/test/passing/refs.janestreet/max_indent.ml.err @@ -0,0 +1 @@ +Warning: max_indent.ml:34 exceeds the margin diff --git a/test/passing/refs.janestreet/max_indent.ml.ref b/test/passing/refs.janestreet/max_indent.ml.ref new file mode 100644 index 0000000000..1406353454 --- /dev/null +++ b/test/passing/refs.janestreet/max_indent.ml.ref @@ -0,0 +1,104 @@ +let () = + fooooo + |> List.iter (fun x -> + let x = x $ y in + fooooooooooo x) +;; + +let () = + fooooo + |> List.iter (fun some_really_really_really_long_name_that_doesn't_fit_on_the_line -> + let x = some_really_really_really_long_name_that_doesn't_fit_on_the_line $ y in + fooooooooooo x) +;; + +let foooooooooo = + foooooooooooooooooooooo + |> Option.bind ~f:(function + | Pform.Expansion.Var (Values l) -> Some (static l) + | Macro (Ocaml_config, s) -> + Some (static (expand_ocaml_config (Lazy.force ocaml_config) var s)) + | Macro (Env, s) -> Option.map ~f:static (expand_env t var s)) +;; + +let fooooooooooooo = + match lbls with + | (_, { lbl_all }, _) :: _ -> + let t = + Array.map (fun lbl -> mknoloc (Longident.Lident "?temp?"), lbl, omega) lbl_all + in + fooooooo +;; + +let foooooooooo = + match fooooooooooooo with + | Pexp_construct ({ txt = Lident "::"; _ }, Some { pexp_desc = Pexp_tuple [ _; e2 ]; _ }) + -> + if is_sugared_list e2 + then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) +;; + +let foooooooooooooooooooooooooo = + match foooooooooooooooooooooo with + | Pexp_apply + ( { pexp_desc = + Pexp_ident { txt = Lident (("~-" | "~-." | "~+" | "~+.") as op); loc } + ; pexp_loc + ; pexp_attributes = [] + ; _ + } + , [ (Nolabel, e1) ] ) -> fooooooooooooooooooooooooooooooooooooo +;; + +let fooooooooooooooooooooooooooooooooooo = + match foooooooooooooooooooooo with + | ( Ppat_constraint + (({ ppat_desc = Ppat_var _; _ } as p0), { ptyp_desc = Ptyp_poly ([], t0); _ }) + , Pexp_constraint (e0, t1) ) + when Poly.(t0 = t1) -> m.value_binding m +;; + +let foooooooooooooooooooooooooooooooo = + match foooooooooooooooooooooooooooo with + | Tpat_variant (lab, Some omega, _) -> + fun q rem -> + (match q.pat_desc with + | Tpat_variant (lab', Some arg, _) when lab = lab' -> p, arg :: rem + | Tpat_any -> p, omega :: rem + | _ -> raise NoMatch) +;; + +let x = + some_fun________________________________ + some_arg______________________________ + (fun param -> + do_something (); + do_something_else (); + return_this_value) +;; + +let x = + some_fun________________________________ + some_arg______________________________ + ~f:(fun param -> + do_something (); + do_something_else (); + return_this_value) +;; + +let x = + some_value + |> some_fun (fun x -> + do_something (); + do_something_else (); + return_this_value) +;; + +let x = + some_value + ^ some_fun (fun x -> + do_something (); + do_something_else (); + return_this_value) +;; diff --git a/test/passing/refs.janestreet/mod_type_subst.ml.ref b/test/passing/refs.janestreet/mod_type_subst.ml.ref new file mode 100644 index 0000000000..065c18c9af --- /dev/null +++ b/test/passing/refs.janestreet/mod_type_subst.ml.ref @@ -0,0 +1,179 @@ +(** Basic *) +module type x = sig + type t = int +end + +module type t = sig + module type x + + module M : x +end + +module type t' = t with module type x = x +module type t'' = t with module type x := x + +module type t3 = + t + with + module type x = sig + type t + end + +module type t4 = + t + with + module type x := sig + type t + end + +(** nested *) + +module type ENDO = sig + module Inner : sig + module type T + + module F (_ : T) : T + end +end + +module type ENDO_2 = ENDO with module type Inner.T = ENDO +module type ENDO_2' = ENDO with module type Inner.T := ENDO + +module type S = sig + module M : sig + module type T + end + + module N : M.T +end + +module type R = S with module type M.T := sig end + +(** Adding equalities *) + +module type base = sig + type t = + | X of int + | Y of float +end + +module type u = sig + module type t = sig + type t = + | X of int + | Y of float + end + + module M : t +end + +module type s = u with module type t := base + +module type base = sig + type t = + | X of int + | Y of float +end + +module type u = sig + type x + type y + + module type t = sig + type t = + | X of x + | Y of y + end + + module M : t +end + +module type r = u with type x = int and type y = float and module type t = base +module type r = u with type x = int and type y = float and module type t := base + +(** First class module types require an identity *) + +module type fst = sig + module type t + + val x : (module t) +end + +module type ext +module type fst_ext = fst with module type t = ext +module type fst_ext = fst with module type t := ext +module type fst_erased = fst with module type t := sig end +module type fst_ok = fst with module type t = sig end + +module type S = sig + module M : sig + module type T + end + + val x : (module M.T) +end + +module type R = S with module type M.T := sig end + +module type S = sig + module M : sig + module type T + + val x : (module T) + end +end + +module type R = S with module type M.T := sig end + +(** local module type substitutions *) + +module type s = sig + module type u := sig + type a + type b + type c + end + + module type r = sig + type r + + include u + end + + module type s = sig + include u + + type a = A + end +end + +module type s = sig + module type u := sig + type a + type b + type c + end + + module type wrong = sig + type a + + include u + end +end + +module type fst = sig + module type t := sig end + + val x : (module t) +end + +module type hidden = sig + module type t := sig + type u + end + + include t + + val x : (module t) + val x : int +end diff --git a/test/passing/refs.janestreet/module.ml.ref b/test/passing/refs.janestreet/module.ml.ref new file mode 100644 index 0000000000..f8f86a83e4 --- /dev/null +++ b/test/passing/refs.janestreet/module.ml.ref @@ -0,0 +1,113 @@ +module AAAAAAAAAAAAAAAAAAA = Soooooooooooooooooooooooome.Loooooooooooooooooooooooong.Mod + +let _ = + let module A = B in + let module AAAAAAAAAAAAAAAAAAA = + Soooooooooooooooooooooooome.Loooooooooooooooooooooooong.Mod + in + t +;; + +let create (type a b) t i w p = + let module T = (val (t : (a, b) t)) in + T.create i w p +;; + +module C = struct + module rec A : sig + type t + + module rec B : sig + type t + type z + end + + and A : B + end = + A + + and B : sig end = B +end + +module O : sig + type t + end + with type t := t = struct + let () = () +end + +module O : sig + type t + end + with type t := t + and type s := s = struct + let () = () +end + +include struct + (* a *) +end + +include A (struct + (* a *) +end) + +let x : (module S) = (module struct end) +let x = (module struct end : S) + +module rec A : (sig + type t + end + with type t = int) = struct + type t = int +end + +module A (_ : S) = struct end +module A : functor (_ : S) -> S' = functor (_ : S) -> struct end + +let helper ?x = + match x with + | Some (module X : X_typ) -> X.f + | None -> X_add_one.f +;; + +let helper ?x:((module X) = (module X_add_one : X_typ)) = X.f + +module GZ : functor (X : sig end) () (Z : sig end) -> sig end = (val Mooooooooooooooooooo) +module GZZZZZZZZZZZZZZ : functor (X : sig end) () (Z : sig end) -> sig end = _ +module M = struct end +module M = F () +module M = F (* xxx *) ( (* xxx *) ) (* xxx *) +module M = F (struct end) +module M = F (G) () +module M = F (G) ( (* xxx *) ) +module M = F (G) (struct end) + +module M = + F + (struct + val x : t + val y : t + end) + ( (* struct type z = K.y end *) ) + +let _ = + let module M = (val (* aa *) m (* bb *) : (* cc *) M (* dd *) :> (* ee *) N (* ff *)) in + let module M = + (val m : M with type t = k and type p = k :> N with type t = t and type k = t) + in + let module M = + (val (* aa *) m (* bb *) + : (* cc *) + M with type t = t (* dd *) + :> (* ee *) + N with type t = t (* ff *)) + in + () +;; + +module M = + [%demo + module Foo = Bar + + type t] diff --git a/test/passing/refs.janestreet/module_anonymous.ml.ref b/test/passing/refs.janestreet/module_anonymous.ml.ref new file mode 100644 index 0000000000..fad6882370 --- /dev/null +++ b/test/passing/refs.janestreet/module_anonymous.ml.ref @@ -0,0 +1,30 @@ +module _ = struct + let x = 13, 37 +end + +module rec A : sig + type t = B.t +end = + A + +and _ : sig + type t = A.t + + val x : int * int +end = struct + type t = B.t + + let x = 4, 2 +end + +and B : sig + type t +end = struct + type t + + let x = "foo", "bar" +end + +module type S + +let f (module _ : S) = () diff --git a/test/passing/refs.janestreet/module_attributes.ml.ref b/test/passing/refs.janestreet/module_attributes.ml.ref new file mode 100644 index 0000000000..27c9a6d688 --- /dev/null +++ b/test/passing/refs.janestreet/module_attributes.ml.ref @@ -0,0 +1,43 @@ +include (functor [@warning "item"] (M : S) -> N) [@@warning "structure"] + +include struct + type t +end [@warning "item"] [@@warning "structure"] + +include M [@warning "item"] [@@warning "structure"] +include (M : S) [@warning "item"] [@@warning "structure"] +include M (N) [@warning "item"] [@@warning "structure"] +include [%ext] [@warning "item"] [@@warning "structure"] +include (val M) [@warning "item"] [@@warning "structure"] + +include + (val Aaaaaaaaaaaaaaaa.Bbbbbbbbbbbbbbbb.Cccccccccccccccc.Dddddddddddddddd) + [@warning "item"] [@@warning "structure"] + +include (List : module type of Foo with module A := A [@warning "-3"] with module B := B) + +include ( + List : + (module type of Foo + with module A := A + [@warning "-3"] [@warning "-3"] + with module B := B + [@warning "-3"])) + +include ( + List : + (module type of Pervasives + with module A := A + [@warning "-3"] [@warning "-3"] + with module B := B + [@warning "-3"] [@warning "-3"])) +[@warning "-3"] + +module My_module_name : sig end = struct end +(* some arbitrary comment *) +[@ocaml.warning "-60"] + +module type A = sig + module [@attr] A := A.B + module A := A.B [@@attr] +end diff --git a/test/passing/refs.janestreet/module_item_spacing-preserve.ml.ref b/test/passing/refs.janestreet/module_item_spacing-preserve.ml.ref new file mode 100644 index 0000000000..d7f3a64f54 --- /dev/null +++ b/test/passing/refs.janestreet/module_item_spacing-preserve.ml.ref @@ -0,0 +1,144 @@ +let z = this one is pretty looooooooooooooooooooooooooooooooooong + +and z = so is this oooooooooooooooooooooooooooooooooooooooooooone +let f x = x + 1 +let z = this one is pretty looooooooooooooooooooooooooooooooooong +let z = so is this oooooooooooooooooooooooooooooooooooooooooooone +let g = () + +let f = function + | `a | `b | `c -> foo + | `xxxxxxxxxxxxxxxxxx -> + yyyyyyyyyyyyyyyyyyyyyyyy + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +;; + +let x = 1 + +and y = 2 +let z = this one is pretty looooooooooooooooooooooooooooooooooong +let z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +module A = AA +module B = BB +open AA +module C = CC + +module M = + X + (Y) + (struct + let x = k + end) + +let x = 1 +let y = 2 +let x = 1 + +and y = 2 + +and c = { a : int; b : toto; c : char * char * char; d : [ `Foo | `Bar ] } + +and z = this one is pretty looooooooooooooooooooooooooooooooooong + +and z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +type k = + | A + | B + | K of int * char * string + | E + +let x = 1 +let z = this one (is short) +let y = 2 +let w = + this + one + is + toooooooooooooooooooooooooo + (looooooooooooooooooooooooog but is (originally a one - liner)) +;; +let k = z + +module N = struct + let x = 1 + + let z = soooooooooo is this oooooooooooooooooooooooooooooooooooooooooooone + + let y = 2 + let z = soooooooooo iis this oooooooooooooooooooooooooooooooooooooooooooone + let y = 2 + module A = AA + include A + module B = BB + open B +end + +let x = x + +(** comment *) +and y = y + +let x = x + +(** floating comment *) + +and y = y + +let x = x + +and y = + something + veeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeery + veeeeeeeeeeeeeeeeeeeeeeeeeeeery + long +;; + +let y = + something + veeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeery + veeeeeeeeeeeeeeeeeeeeeeeeeeeery + long + +and x = x + +let a = a + +and a = a + +and a = a + +and a = a + +and a = a + +and a = a + +let x = 1 + +(* floating *) + +let y = 2 + +let cmos_rtc_seconds = 0x00 +let cmos_rtc_seconds_alarm = 0x01 +let cmos_rtc_minutes = 0x02 + +let x = o + +let log_other = 0x000001 +let log_cpu = 0x000002 +let log_fpu = 0x000004 + +let cr0_pe = 1 lsl 0 +let cr0_mp = 1 lsl 1 +let cr0_em = 1 lsl 2 + +(* with double semicolons *) + +let foo = fooooooooooooooooooooooooooooo + +let foo = fooooooooooooooooooooooooooooo diff --git a/test/passing/refs.janestreet/module_item_spacing-sparse.ml.ref b/test/passing/refs.janestreet/module_item_spacing-sparse.ml.ref new file mode 100644 index 0000000000..686f5111a0 --- /dev/null +++ b/test/passing/refs.janestreet/module_item_spacing-sparse.ml.ref @@ -0,0 +1,165 @@ +let z = this one is pretty looooooooooooooooooooooooooooooooooong + +and z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +let f x = x + 1 + +let z = this one is pretty looooooooooooooooooooooooooooooooooong + +let z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +let g = () + +let f = function + | `a | `b | `c -> foo + | `xxxxxxxxxxxxxxxxxx -> + yyyyyyyyyyyyyyyyyyyyyyyy + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +;; + +let x = 1 + +and y = 2 + +let z = this one is pretty looooooooooooooooooooooooooooooooooong + +let z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +module A = AA +module B = BB +open AA +module C = CC + +module M = + X + (Y) + (struct + let x = k + end) + +let x = 1 + +let y = 2 + +let x = 1 + +and y = 2 + +and c = { a : int; b : toto; c : char * char * char; d : [ `Foo | `Bar ] } + +and z = this one is pretty looooooooooooooooooooooooooooooooooong + +and z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +type k = + | A + | B + | K of int * char * string + | E + +let x = 1 + +let z = this one (is short) + +let y = 2 + +let w = + this + one + is + toooooooooooooooooooooooooo + (looooooooooooooooooooooooog but is (originally a one - liner)) +;; + +let k = z + +module N = struct + let x = 1 + + let z = soooooooooo is this oooooooooooooooooooooooooooooooooooooooooooone + + let y = 2 + + let z = soooooooooo iis this oooooooooooooooooooooooooooooooooooooooooooone + + let y = 2 + + module A = AA + include A + module B = BB + open B +end + +let x = x + +(** comment *) +and y = y + +let x = x + +(** floating comment *) + +and y = y + +let x = x + +and y = + something + veeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeery + veeeeeeeeeeeeeeeeeeeeeeeeeeeery + long +;; + +let y = + something + veeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeery + veeeeeeeeeeeeeeeeeeeeeeeeeeeery + long + +and x = x + +let a = a + +and a = a + +and a = a + +and a = a + +and a = a + +and a = a + +let x = 1 + +(* floating *) + +let y = 2 + +let cmos_rtc_seconds = 0x00 + +let cmos_rtc_seconds_alarm = 0x01 + +let cmos_rtc_minutes = 0x02 + +let x = o + +let log_other = 0x000001 + +let log_cpu = 0x000002 + +let log_fpu = 0x000004 + +let cr0_pe = 1 lsl 0 + +let cr0_mp = 1 lsl 1 + +let cr0_em = 1 lsl 2 + +(* with double semicolons *) + +let foo = fooooooooooooooooooooooooooooo + +let foo = fooooooooooooooooooooooooooooo diff --git a/test/passing/refs.janestreet/module_item_spacing.ml.ref b/test/passing/refs.janestreet/module_item_spacing.ml.ref new file mode 100644 index 0000000000..a8893e453e --- /dev/null +++ b/test/passing/refs.janestreet/module_item_spacing.ml.ref @@ -0,0 +1,132 @@ +let z = this one is pretty looooooooooooooooooooooooooooooooooong +and z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +let f x = x + 1 +let z = this one is pretty looooooooooooooooooooooooooooooooooong +let z = so is this oooooooooooooooooooooooooooooooooooooooooooone +let g = () + +let f = function + | `a | `b | `c -> foo + | `xxxxxxxxxxxxxxxxxx -> + yyyyyyyyyyyyyyyyyyyyyyyy + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +;; + +let x = 1 +and y = 2 + +let z = this one is pretty looooooooooooooooooooooooooooooooooong +let z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +module A = AA +module B = BB +open AA +module C = CC + +module M = + X + (Y) + (struct + let x = k + end) + +let x = 1 +let y = 2 + +let x = 1 +and y = 2 +and c = { a : int; b : toto; c : char * char * char; d : [ `Foo | `Bar ] } +and z = this one is pretty looooooooooooooooooooooooooooooooooong +and z = so is this oooooooooooooooooooooooooooooooooooooooooooone + +type k = + | A + | B + | K of int * char * string + | E + +let x = 1 +let z = this one (is short) +let y = 2 + +let w = + this + one + is + toooooooooooooooooooooooooo + (looooooooooooooooooooooooog but is (originally a one - liner)) +;; + +let k = z + +module N = struct + let x = 1 + let z = soooooooooo is this oooooooooooooooooooooooooooooooooooooooooooone + let y = 2 + let z = soooooooooo iis this oooooooooooooooooooooooooooooooooooooooooooone + let y = 2 + + module A = AA + include A + module B = BB + open B +end + +let x = x + +(** comment *) +and y = y + +let x = x + +(** floating comment *) + +and y = y + +let x = x + +and y = + something + veeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeery + veeeeeeeeeeeeeeeeeeeeeeeeeeeery + long +;; + +let y = + something + veeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeery + veeeeeeeeeeeeeeeeeeeeeeeeeeeery + long + +and x = x + +let a = a +and a = a +and a = a +and a = a +and a = a +and a = a + +let x = 1 + +(* floating *) + +let y = 2 +let cmos_rtc_seconds = 0x00 +let cmos_rtc_seconds_alarm = 0x01 +let cmos_rtc_minutes = 0x02 +let x = o +let log_other = 0x000001 +let log_cpu = 0x000002 +let log_fpu = 0x000004 +let cr0_pe = 1 lsl 0 +let cr0_mp = 1 lsl 1 +let cr0_em = 1 lsl 2 + +(* with double semicolons *) + +let foo = fooooooooooooooooooooooooooooo +let foo = fooooooooooooooooooooooooooooo diff --git a/test/passing/refs.janestreet/module_item_spacing.mli.ref b/test/passing/refs.janestreet/module_item_spacing.mli.ref new file mode 100644 index 0000000000..a8c592eb34 --- /dev/null +++ b/test/passing/refs.janestreet/module_item_spacing.mli.ref @@ -0,0 +1,114 @@ +[@@@ocamlformat "module-item-spacing=compact"] + +val z : this one is pretty looooooooooooooooooooooooooooooooooong +val z : so is this oooooooooooooooooooooooooooooooooooooooooooone + +(** [f o o o o o o] is a great function. *) +val f : k -> k -> k -> k -> k k -> k k -> k k + +val z : this one is pretty looooooooooooooooooooooooooooooooooong +val z : so is this oooooooooooooooooooooooooooooooooooooooooooone +val g : unit + +val f + : aaaaaaaaaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccccc + -> dddddddddddd + +(** [x] is a great value. *) +val x : k + +val z : k + +(** [y] is a great value. *) +val y : k + +val z : this one is pretty looooooooooooooooooooooooooooooooooong +val z : so is this oooooooooooooooooooooooooooooooooooooooooooone + +module A = AA +module B = BB +open AA +module C = CC + +module type M = sig + val a : z + val b : zz + val c : zzz +end + +val x : k +val y : k +val x : k +val y : k + +type c = + { a : int + ; b : toto + ; c : char * char * char + ; d : [ `Foo | `Bar ] + } + +val z : this one is pretty looooooooooooooooooooooooooooooooooong +val z : so is this oooooooooooooooooooooooooooooooooooooooooooone + +type k = + | A + | B + | K of int * char * string + | E + +val x : k +val z : this one is short +val y : k + +val w + : this one is toooooooooooooooooooooooooo looooooooooooooooooooooooog but is originally + a + one_liner + +val k : z + +module type N = sig + val x : k + val z : soooooooooo is this oooooooooooooooooooooooooooooooooooooooooooone + val y : k + val z : soooooooooo iis this oooooooooooooooooooooooooooooooooooooooooooone + val y : k + + module A = AA + include A + module B = BB + open B +end + +[@@@ocamlformat "module-item-spacing=preserve"] + +val cmos_rtc_seconds : foo +val cmos_rtc_seconds_alarm : foo +val cmos_rtc_minutes : foo + +val x : foo + +val log_other : foo +val log_cpu : foo +val log_fpu : foo + +val cr0_pe : foo +val cr0_mp : foo +val cr0_em : foo + +module C : sig + type config = t + + type 'a t + + type parsed_from = + [ `File of Fpath.t * int + | `Attribute + ] +end + +module A := A +module A := A.B diff --git a/test/passing/refs.janestreet/module_type.ml.err b/test/passing/refs.janestreet/module_type.ml.err new file mode 100644 index 0000000000..802fdf5242 --- /dev/null +++ b/test/passing/refs.janestreet/module_type.ml.err @@ -0,0 +1 @@ +Warning: module_type.ml:36 exceeds the margin diff --git a/test/passing/refs.janestreet/module_type.ml.ref b/test/passing/refs.janestreet/module_type.ml.ref new file mode 100644 index 0000000000..38fd1e31e1 --- /dev/null +++ b/test/passing/refs.janestreet/module_type.ml.ref @@ -0,0 +1,112 @@ +module type S = sig + val x : unit -> unit +end + +let get = failwith "TODO" + +let foo () = + let module X = (val get : S) in + X.x () +;; + +module type S = sig end + +type t = (module S) +type 'a monoid_a = (module Monoid with type t = 'a) +type 'a monoid_a = (module Monoid with type F.t = 'a) + +let sumi (type a) ((module A) : a monoid_a) (n : a) = A.mappend n A.mempty + +module type BAR = sig + module rec A : (FOO with type t = < b : B.t >) + and B : FOO +end + +module type M = + module type of M + with module A := A + (*test*) + and module A = A + (*test*) + and module A = A + with module A = A + (*test*) + with module A = A + +module U : + S with type ttttttttt = int and type uuuuuuuu = int and type vvvvvvvvvvv = int = struct end + +module U : S with type ttttttttt = int and type uuuuuuu = int with type vvvvvvvvv = int = +struct end + +module U : + S + with type Command.t = + [ `Halt + | `Unknown + | `Error of string + | `Config of (string * string) list + | `Format of string + ] + and type Command.t = + [ `Halt + | `Unknown + | `Error of string + | `Config of (string * string) list + | `Format of string + ] = struct end + +module U = (val S : S with type t = int and type u = int) +module U = (val S : S with type t = int and type u = int) + +module type S = sig + (* floating *) + + exception E +end + +module type S' = functor + (A : A) + (B : sig + type t + end) + (Cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc : sig + type t + end) + -> S with type t = B.t + +module M : sig + include (* foo *) module type of K + + include module type of + Fooooooooooooooooooooooooooo (Foooooooooo.Foo) (Fooooooooooooo) (Fooooooooooooo) + + include (* fooooooooo *) module type of + Fooooooooooooooooooooooooooo (Foooooooooo.Foo) (Fooooooooooooo) (Fooooooooooooo) +end = struct end + +let foo + (type foooo fooo_ooooo) + (module Fooo : Fooooo_foooooooooo.Foooo_intf.Bar + with type foooo = foooo + and type Fooo_fooooooooo_fooooo.t = + ( xxxxx + , wwwwwwwwww + , xxxxxxxxxxxxxxxxxxxx + , xxxxxxxxxxxxxxxxx + , xxxxxxxxxxxxxxxxxxxxxx + , yyyyyyyyyyyyyyyyyyyyyy ) + Fooooo_ooooooo_oooooo.Foooo_fooooooooo_fooooo.t) + (Fooo.Fooo.T (foo, bar)) + xxxx + = + () +;; + +module N : S with module type T = (U with module M = M) = struct end + +module type Grammar = functor + (Nonterm : Nonterminal) + (* Set of nonterminals *) + (Attr : Attribute) + -> sig end diff --git a/test/passing/refs.janestreet/module_type.mli.ref b/test/passing/refs.janestreet/module_type.mli.ref new file mode 100644 index 0000000000..30cf318687 --- /dev/null +++ b/test/passing/refs.janestreet/module_type.mli.ref @@ -0,0 +1,4 @@ +(* Wrapping an empty sig *) +module Foo + (A : FOO) + (B : FOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO) : sig end diff --git a/test/passing/refs.janestreet/monadic_binding.ml.ref b/test/passing/refs.janestreet/monadic_binding.ml.ref new file mode 100644 index 0000000000..3897994da1 --- /dev/null +++ b/test/passing/refs.janestreet/monadic_binding.ml.ref @@ -0,0 +1,39 @@ +let ( let* ) t f = fooooooo +let ( and* ) t1 t2 = foooooo + +let map f t = + let* a = t in + pure (f a) +;; + +let ( and+ ) t1 t2 = ( and* ) t1 t2 +let ( and+ ) t1 t2 = ( and* ) t1 t2 x + +let ( and+ ) t1 t2 = + ( and* ) + t1 + t2 + x + foooooooooooooooooo + foooooooooooooooooooo + foooooooooooooooooo + foooooooooooooooooo +;; + +let _ = ( let* ) x (fun y -> z) +let _ = ( let* ) x (function y -> z) +let _ = f (( let* ) x (fun y -> z)) +let _ = f (( let* ) x (function y -> z)) +let _ = ( let+ ) [@attr] +let _ = f (( let+ ) [@attr]);; + +( let+ ) [@attr] + +let _ = + let* (args, _) : bar = () in + let* (arg : bar) = () in + let* (_ : foo) = () in + let* (_ as t) = xxx in + let+ (Ok x) = xxx in + () +;; diff --git a/test/passing/refs.janestreet/multi_index_op.ml.ref b/test/passing/refs.janestreet/multi_index_op.ml.ref new file mode 100644 index 0000000000..14c330ada5 --- /dev/null +++ b/test/passing/refs.janestreet/multi_index_op.ml.ref @@ -0,0 +1,13 @@ +let ( .%{;..} ) = Genarray.get +let ( .%{;..}<- ) = Genarray.set + +let () = + let x = Genarray.create Float64 c_layout [| 3; 4; 5 |] in + x.%{0; 0; 0} <- 3.; + Printf.printf "%f\n" x.%{0; 0; 0} +;; + +(** With path *) + +let _ = a.A.B.*(b; c) +let _ = a.A.B.*(b; c) <- d diff --git a/test/passing/refs.janestreet/named_existentials.ml.ref b/test/passing/refs.janestreet/named_existentials.ml.ref new file mode 100644 index 0000000000..fa35a5173d --- /dev/null +++ b/test/passing/refs.janestreet/named_existentials.ml.ref @@ -0,0 +1,32 @@ +let ok1 = function + | Dyn (type a) ((w, x) : a ty * a) -> ignore (x : a) +;; + +let ok2 = function + | Dyn (type a) ((w, x) : _ * a) -> ignore (x : a) +;; + +type u = C : 'a * ('a -> 'b list) -> u + +let f = function + | C (type a b) ((x, f) : _ * (a -> b list)) -> ignore (x : a) +;; + +(* with GADT unification *) +type _ expr = + | Int : int -> int expr + | Add : (int -> int -> int) expr + | App : ('a -> 'b) expr * 'a expr -> 'b expr + +let rec eval : type t. t expr -> t = function + | Int n -> n + | Add -> ( + ) + | App (type a) ((f, x) : _ * a expr) -> eval f (eval x : a) +;; + +(* Also allow annotations on multiary constructors *) +type ('a, 'b) pair = Pair of 'a * 'b + +let f = function + | Pair ((x, y) : int * _) -> x + y +;; diff --git a/test/passing/refs.janestreet/need_format.ml.err b/test/passing/refs.janestreet/need_format.ml.err new file mode 100644 index 0000000000..5f78142e1f --- /dev/null +++ b/test/passing/refs.janestreet/need_format.ml.err @@ -0,0 +1 @@ +ocamlformat: "need_format.ml" was not already formatted. ([max-iters = 1]) diff --git a/test/passing/refs.janestreet/new.ml.ref b/test/passing/refs.janestreet/new.ml.ref new file mode 100644 index 0000000000..3a1e49ea84 --- /dev/null +++ b/test/passing/refs.janestreet/new.ml.ref @@ -0,0 +1,8 @@ +let x = new Objects.one ~hello:true () +let _ = sprintf "Date: %s" (Js.to_string (new%js Js.date_now)##toString) +let _ = f (new test) a b +let _ = f (new test x) a b +let _ = f (new test (new test a b) c) a b +let _ = f (new%js test) a b +let _ = f (new%js test x) a b +let _ = f (new%js test (new%js test a b) c) a b diff --git a/test/passing/refs.janestreet/object.ml.ref b/test/passing/refs.janestreet/object.ml.ref new file mode 100644 index 0000000000..95fd9f06ab --- /dev/null +++ b/test/passing/refs.janestreet/object.ml.ref @@ -0,0 +1,275 @@ +let _ = + object + (* some comment *) + inherit M.t as p [@@attr] + + (* some comment *) + method! x = 2 [@@attr] + method x = (1 [@attr]) + method virtual x : t + method virtual private x : t + method! private x = 3 + method! private x : t = 4 + method! private x : type a b c. r = 5 + method! private x : type a. r = 6 + val virtual x : t + val virtual mutable x : t + val virtual mutable x : t + val! mutable x = 7 + val! mutable x : t = 8 + constraint t = 'a t + [%%ext salut, "hello"] + [@@@attr] + + initializer + f x; + 9 + + initializer + let x = y in + z + + method x = + let f = {<a; b = e>} in + x <- expr + + method x : type a b c. (a, b) t -> c = + let f = {<a; b = e>} in + x <- expr + + method x : (a, b) t -> c = + let f = + {<a; b = something very loooooooooooooooooooooooooooooooooooooooooooooooong>} + in + x + <- something + very + looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong + end +;; + +let _ = f a#b (a#c x y) +let _ = f a##.b (a##c x y) + +type t = (int, int) #q + +let _ = object%js end +let _ = object%js (super) end +let _ = object%js (super : 'a) end +let _ = f (object end) +let _ = f (object%js end) + +class t ~a = + object + inherit f a + method x a b = a + b + end + +class type mapper = [%test] + +module type A = sig + class mapper : int -> x:int -> ?y:int -> object + method xxxxxxxxxxxxxxxxxxxxxxxxxxx : int + end + + class tttttttttttt : + aaaaaaaaaaaaaaaaaa:int + -> bbbbbbbbbbbbbbbbbbbbb:float + -> cccccccccccccccccccc + + class c : object + inherit ['a a] d + constraint 'a = int + [%%ext something] + [@@@attr something] + val (*x*) virtual (*y*) mutable (*z*) a : int + val (*x*) mutable (*y*) virtual (*z*) a : int + method (*x*) virtual (*y*) private (*z*) b : int -> int -> int + method (*x*) private (*y*) virtual (*z*) b : int -> int -> int + end +end + +class type mapper = + let open Modl1 in +object + method expression : Javascript.expression -> Javascript.expression + method expression_o : Javascript.expression option -> Javascript.expression option + + method switch_case : + Javascript.expression -> Javascript.expression -> a -> b -> ccccccccccc -> d -> e +end + +class tttttttttttttttttttttttttt ~aaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb = + object + inherit f a + method x a b = a + b + end + +class tttttttttttttttttttttttttt x y = + let open Mod in + let x = 2 in + let f x = + object + inherit f a + method x a b = a + b + end + in + f 0 + +class tttttttttttttttttttttttttt x y = + let open Mod in + let x = 2 in + (fun x -> + object + inherit f a + method x a b = a + b + end) + 0 + +class c = + object + (** about a *) + method a : type a b c. d -> e -> f = g + + (** floatting *) + + (** about a *) + method a : 'a. d -> e -> f = g + end + +(** about a *) +class a = object end + +(** floatting *) + +(** about b *) +and b = object end + +class type x = object + (** floatting1 *) + + (** floatting2 *) + + method x : int + + (** floatting3 *) +end + +class x = + object + + (** floatting1 *) + + (** floatting2 *) + + method x = 2 + + (** floatting3 *) + end + +let _ = f##=(fun x -> x) + +let o = + object + method int_bin_op : int t * [ `Plus | `Minus | `Mult | `Div | `Mod ] * int t -> int t + = + fun (a, op, b) -> Int_bin_op (self#expression a, op, self#expression b) + + method int_bin_comparison + aaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbb + ccccccccccccccccccccc + ddddddddddddddddddddddddd + : int t * [ `Eq | `Ne | `Gt | `Ge | `Lt | `Le ] * int ttttttttt + -> bool tttttttttttttttt rrrrrrrrrrrrrrrrrrrrr rrrrrrrrrrrrrrrrrrrrr + rrrrrrrrrrrrrrrrrrrrrrr = + fun (a, op, b) -> Int_bin_comparison (self#expression a, op, self#expression b) + end +;; + +class f = fun [@inline] (b [@inline]) -> object end +class f = [%test] [@test] +class f a (b [@inline]) = object end + +class f = + object (self) + inherit + [a] c + (f 1) + (fun x -> x) + (match x with + | x -> x) as p + end + +class f ((i, o) as io) = + object (self) + inherit + [a] c + (f 1) + (fun x -> x) + (match x with + | x -> x) as p + end + +class type ['a] tsv = object + inherit [ < sep : [ `tab ] ; comment : [ `sharp ] ; .. > as 'a] tabular +end +;; + +{<(* Debug.print ("free var: "^string_of_int x); *) free_vars = IntSet.add x free_vars>};; +{<(* Debug.print ("free var: "^string_of_int x); *) free_vars>};; +{<(* Debug.print ("free var: "^string_of_int x); *) very_loooooooooooong_identifier>};; + +{<(* Debug.print ("free var: "^string_of_int x); *) + x = (Some k : t) + ; (* Debug.print ("free var: "^string_of_int x); *) + y = yet another value>} +;; + +{<(* check: e is effectively the index associated with e, and check that + already in *) + x = y>} + +class type a = b[@attr] +class type a = object end[@attr] + +(* Syntax error: class type a = b -> c[@attr] *) +(* Cannot attach attribute: class a : b -> c = d *) + +class type a = [%ext][@attr] + +class type a = + let open[@attr] A in + b + +class a = + let open[@attr] A in + b + +class t (lazy _) = object end + +class virtual c = + let (mc_exit : _) = () in + object end + +(* Fitting *) + +class a = object end +class a x = object end +class a x = object end +class a x = object (self) end + +let x = + fun [@foo] x -> + fun [@foo] y -> + object + method x = y + end +;; + +class x = + fun [@foo] x -> + fun [@foo] y -> + object + method x = y + end diff --git a/test/passing/refs.janestreet/object2.ml.ref b/test/passing/refs.janestreet/object2.ml.ref new file mode 100644 index 0000000000..28aa6086c5 --- /dev/null +++ b/test/passing/refs.janestreet/object2.ml.ref @@ -0,0 +1,28 @@ +let x = + object + inherit foo + method bar = _ + end +;; + +class foo = + object + method x = 2 + inherit bar + end + +class foo = + object (this) + inherit bar + end + +class virtual map = + object + method visit_expr_node + : 'env 'info_0 'info_1. + ('env -> 'info_0 -> 'info_1) + -> 'env + -> 'info_0 expr_node + -> 'info_1 expr_node = + assert false + end diff --git a/test/passing/refs.janestreet/object_expr-414.ml.ref b/test/passing/refs.janestreet/object_expr-414.ml.ref new file mode 100644 index 0000000000..57a3b2bf5c --- /dev/null +++ b/test/passing/refs.janestreet/object_expr-414.ml.ref @@ -0,0 +1,24 @@ +object + method one = 1 +end + #one +;; + +Some + object + method one = 1 + end +;; + +ignore + object + method one = 1 + end + +let () = + f + (object + method m x = x + end + [@xxx]) +;; diff --git a/test/passing/refs.janestreet/object_expr.ml.ref b/test/passing/refs.janestreet/object_expr.ml.ref new file mode 100644 index 0000000000..9a810b6f83 --- /dev/null +++ b/test/passing/refs.janestreet/object_expr.ml.ref @@ -0,0 +1,24 @@ +(object + method one = 1 +end) + #one +;; + +Some + (object + method one = 1 + end) +;; + +ignore + (object + method one = 1 + end) + +let () = + f + (object + method m x = x + end + [@xxx]) +;; diff --git a/test/passing/refs.janestreet/object_type.ml.ref b/test/passing/refs.janestreet/object_type.ml.ref new file mode 100644 index 0000000000..8e8eccff35 --- /dev/null +++ b/test/passing/refs.janestreet/object_type.ml.ref @@ -0,0 +1,72 @@ +type t = + < hello : string (** some doc *) + ; world : int + ; more : int * float + ; make : int + ; it : string + ; long : float [@default 42.] > +[@@deriving make] + +type 'a u = < hello : string (** more doc *) ; world : int ; .. > as 'a +type 'a v = < .. > as 'a +type 'a w = (< .. > as 'a) -> 'a +type z = < > t + +let x : unit -> < bouh : string ; .. > = fun () -> assert false +let lookup_obj : < .. > -> (< .. > as 'a) list -> 'a = fun _ -> assert false +let _ = [%ext: < a ; b > ] +let _ = x [@att: < a ; b > ] + +type t = [ `A of < a ; b > ] +type t = private [> ] +type t = < a : < > > + +type t = + { a : < > + ; b : int + } + +type t = + { b : int + ; a : < > + } + +class type c = object + inherit [ < a : 'a ; b : 'b > ] a + inherit [a, b, c] a +end + +class c = + object + inherit [ < a : 'a ; b : 'b > ] a + inherit [a, b, c] a + end + +type 'a u = [< `A | `B of < > > `B ] as 'a + +(** about a *) +class type a = object + (** about a *) + method a : int + + (** floatting *) + + (** about b *) + method b : int +end + +(** floatting *) + +(** about b *) +and b = object end + +class type i = object + (* test *) + inherit oo +end + +class i = + object + (* test *) + inherit oo + end diff --git a/test/passing/refs.janestreet/obuild.ml.ref b/test/passing/refs.janestreet/obuild.ml.ref new file mode 100644 index 0000000000..bedd66638c --- /dev/null +++ b/test/passing/refs.janestreet/obuild.ml.ref @@ -0,0 +1,12 @@ +type predicate = + | Pred_Byte + | Pred_Native + | Pred_Toploop + +let _ = + { pkg with + package_version = projFile.version + ; package_description = _ + ; package_requires = [] + } +;; diff --git a/test/passing/refs.janestreet/ocp_indent_compat-break_colon_after.ml.ref b/test/passing/refs.janestreet/ocp_indent_compat-break_colon_after.ml.ref new file mode 100644 index 0000000000..1276bb7eed --- /dev/null +++ b/test/passing/refs.janestreet/ocp_indent_compat-break_colon_after.ml.ref @@ -0,0 +1,101 @@ +(* Bad: unboxing the function type *) +external i : (int -> float[@unboxed]) = "i" "i_nat" + +module type M = sig + (** Formatting action: input type and source, and output destination. *) + val action : action + + val doc_atrs : + (string Location.loc * payload) list + -> (string Location.loc * bool) list option * (string Location.loc * payload) list + + val transl_modtype_longident + (* from Typemod *) : + (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val transl_modtype_longident + (* foooooooooo fooooooooooooo foooooooooooo foooooooooooooo + foooooooooooooo foooooooooooo + *) : + (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val imported_sets_of_closures_table : + Simple_value_approx.function_declarations option Set_of_closures_id.Tbl.t + + type 'a option_decl = + names:string list + -> doc:string + -> section:[ `Formatting | `Operational ] + -> ?allow_inline:bool + -> (config -> 'a -> config) + -> (config -> 'a) + -> 'a t + + val select : + (* The fsevents context *) + env + -> (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list + -> (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list + -> (* Timeout...like Unix.select *) + timeout:float + -> (* The callback for file system events *) + (event list -> unit) + -> unit + + val f : + x:t + (** an extremely long comment about [x] that does not fit on the + same line with [x] *) + -> unit + + val f : + fooooooooooooooooo: + (fooooooooooooooo + -> fooooooooooooooooooo + -> foooooooooooooo + -> foooooooooooooo * fooooooooooooooooo + -> foooooooooooooooo) + (** an extremely long comment about [x] that does not fit on the + same line with [x] *) + -> unit +end + +let ssmap : + (module MapT with type key = string and type data = string and type map = SSMap.map) + = + () +;; + +let ssmap : + (module MapT with type key = string and type data = string and type map = SSMap.map) + -> unit + = + () +;; + +let long_function_name : type a. a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit + = + fun () -> () +;; + +let add_edge target dep = + if target <> dep + then ( + Hashtbl.replace + edges + dep + (target + :: + (try Hashtbl.find edges dep with + | Not_found -> [])); + Hashtbl.replace + edge_count + target + (1 + + + try Hashtbl.find edge_count target with + | Not_found -> 0); + if not (Hashtbl.mem edge_count dep) then Hashtbl.add edge_count dep 0) +;; diff --git a/test/passing/refs.janestreet/ocp_indent_compat.ml.ref b/test/passing/refs.janestreet/ocp_indent_compat.ml.ref new file mode 100644 index 0000000000..a2f8a0c094 --- /dev/null +++ b/test/passing/refs.janestreet/ocp_indent_compat.ml.ref @@ -0,0 +1,101 @@ +(* Bad: unboxing the function type *) +external i : (int -> float[@unboxed]) = "i" "i_nat" + +module type M = sig + (** Formatting action: input type and source, and output destination. *) + val action : action + + val doc_atrs + : (string Location.loc * payload) list + -> (string Location.loc * bool) list option * (string Location.loc * payload) list + + val transl_modtype_longident + (* from Typemod *) + : (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val transl_modtype_longident + (* foooooooooo fooooooooooooo foooooooooooo foooooooooooooo + foooooooooooooo foooooooooooo + *) + : (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val imported_sets_of_closures_table + : Simple_value_approx.function_declarations option Set_of_closures_id.Tbl.t + + type 'a option_decl = + names:string list + -> doc:string + -> section:[ `Formatting | `Operational ] + -> ?allow_inline:bool + -> (config -> 'a -> config) + -> (config -> 'a) + -> 'a t + + val select + : (* The fsevents context *) + env + -> (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list + -> (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list + -> (* Timeout...like Unix.select *) + timeout:float + -> (* The callback for file system events *) + (event list -> unit) + -> unit + + val f + : x:t + (** an extremely long comment about [x] that does not fit on the + same line with [x] *) + -> unit + + val f + : fooooooooooooooooo: + (fooooooooooooooo + -> fooooooooooooooooooo + -> foooooooooooooo + -> foooooooooooooo * fooooooooooooooooo + -> foooooooooooooooo) + (** an extremely long comment about [x] that does not fit on the + same line with [x] *) + -> unit +end + +let ssmap + : (module MapT with type key = string and type data = string and type map = SSMap.map) + = + () +;; + +let ssmap + : (module MapT with type key = string and type data = string and type map = SSMap.map) + -> unit + = + () +;; + +let long_function_name : type a. a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit + = + fun () -> () +;; + +let add_edge target dep = + if target <> dep + then ( + Hashtbl.replace + edges + dep + (target + :: + (try Hashtbl.find edges dep with + | Not_found -> [])); + Hashtbl.replace + edge_count + target + (1 + + + try Hashtbl.find edge_count target with + | Not_found -> 0); + if not (Hashtbl.mem edge_count dep) then Hashtbl.add edge_count dep 0) +;; diff --git a/test/passing/refs.janestreet/ocp_indent_options.ml.ref b/test/passing/refs.janestreet/ocp_indent_options.ml.ref new file mode 100644 index 0000000000..442bb41d09 --- /dev/null +++ b/test/passing/refs.janestreet/ocp_indent_options.ml.ref @@ -0,0 +1,11 @@ +let _ = + let f x y = + match x with + | None -> false + | Some loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> + (match y with + | Some _ -> true + | None -> false) + in + () +;; diff --git a/test/passing/refs.janestreet/open-closing-on-separate-line.ml.ref b/test/passing/refs.janestreet/open-closing-on-separate-line.ml.ref new file mode 100644 index 0000000000..f99d05d778 --- /dev/null +++ b/test/passing/refs.janestreet/open-closing-on-separate-line.ml.ref @@ -0,0 +1,380 @@ +let _ = Some_module.Submodule.(a + b) +let _ = A.(a, b) + +let _ = + let open Some_module.Submodule in + AAAAAAAAAAAAAAAAAAAAAAAAAAAA.(a + b) +;; + +let _ = + let open Some_module.Submodule in + let module A = MMMMMM in + a + b + c +;; + +let _ = + let open Some_module.Submodule in + let exception A of int in + a + b +;; + +let _ = + let open Some_module.Submodule in + [%except {| result |}] +;; + +let _ = + let open Some_module.Submodule in + [%except {| loooooooooooooooooooooooooong result |}] +;; + +let _ = + let open Some_module.Submodule in + let x = a + b in + let y = f x in + y +;; + +let () = + ( (let open Term in + term_result (const Phases.phase1 $ arch $ hub_id $ build_dir $ logs_dir $ setup_logs) + ) + , Term.info "phase1" ~doc ~sdocs:Manpage.s_common_options ~exits ~man ) +;; + +let () = + (let open Arg in + let doc = "Output all." in + value & flag & info [ "all" ] ~doc + ) + $ + let open Arg in + let doc = "Commit to git." in + value & flag & info [ "commit"; "c" ] ~doc +;; + +let () = + Arg.( + let doc = "Output all." in + value & flag & info [ "all" ] ~doc + ) + $ Arg.( + let doc = "Commit to git." in + value & flag & info [ "commit"; "c" ] ~doc + ) +;; + +let () = X.(f y i) +let () = X.(i) + +let () = + let open X in + f y i +;; + +let () = + let open X in + i +;; + +let () = + let open! K in + x y z +;; + +let x = + let Cstruct.{ buffer = bigstring; off = offset; len = length } = + Cstruct.{ toto = foooo } + in + fooooooooo +;; + +open A +open A.B +open A (B) + +open struct + type t +end + +open ( +struct + type t +end : + T +) + +open ( +struct + type t +end : +sig + type t +end +) + +open (val x) +open (val x) +open [%extension] +open functor (A : T) -> T' + +module type T = sig + open A + open A.B + open A(B) +end + +let x = + let open struct + type t' = t + end in + foo +;; + +let x = + let open struct + open struct + type t = T + end + + let y = T + end in + foo +;; + +let x = + let open struct + open struct + let counter = ref 0 + end + end in + foo +;; + +let x = + let open struct + let open struct + let counter = ref 0 + end in + foo + end in + foo +;; + +let x = + let open struct + module A = struct + open struct + let x = 1 + end + + let y = x + + open struct + let x = 1 + end + + let z = y + x + end + end in + foo +;; + +class type a = + (* A'' *) + let open (* A' *) A (* A *) in + (* B *) + b + +class a = + (* A'' *) + let open (* A' *) A (* A *) in + (* B *) + b + +let _ = + (* a *) + let (* b *) open (* c *) struct + type t + end + (* d *) in + (* e *) + (* f *) + let (* g *) open (* h *) A (* i *) (B) (* j *) in + (* k *) + () +;; + +(* l *) +open (* m *) struct + type t +end +(* n *) + +open A +open B + +open struct + type t +end + +open + functor + (A : S) + -> + struct + type t + end + +open + functor + (_ : S) + -> + struct + type t + end + +open A (B) +open (A : S) +open (val x) +open [%ext] + +let _ = + let open A in + let open B in + let open struct + type t + end in + let open + functor + (A : S) + -> + struct + type t + end in + let open + functor + (_ : S) + -> + struct + type t + end in + let open A (B) in + let open (A : S) in + let open (val x) in + let open [%ext] in + () +;; + +open [@attr] A +open [@attr] B + +open [@attr] struct + type t +end + +open + [@attr] + functor + (A : S) + -> + struct + type t + end + +open + [@attr] + functor + (_ : S) + -> + struct + type t + end + +open [@attr] A (B) +open [@attr] (A : S) +open [@attr] (val x) +open [@attr] [%ext] + +let g = + M.f + ((let open M in + x + ) [@attr] + ) +;; + +let _ = M.({ f } [@warning "foo"]) +let _ = M.((* A *) { f }) +let _ = M.({ f } (* B *)) +let _ = M.((* A *) { f } (* B *)) +let _ = M.((* A *) { f } (* B *) [@warning "foo"] (* C *)) +let _ = M.([| f |] [@warning "foo"]) +let _ = M.((* A *) [| f |]) +let _ = M.([| f |] (* B *)) +let _ = M.((* A *) [| f |] (* B *)) +let _ = M.((* A *) [| f |] (* B *) [@warning "foo"] (* C *)) +let _ = M.([ f ] [@warning "foo"]) +let _ = M.((* A *) [ f ]) +let _ = M.([ f ] (* B *)) +let _ = M.([ f ] (* B *)) (* after *) +let _ = M.((* A *) [ f ] (* B *)) +let _ = M.((* A *) [ f ] (* B *) [@warning "foo"] (* C *)) +let _ = M.(((f, f) [@warning "foo"])) +let _ = M.((* A *) f, f) +let _ = M.(f, f (* B *)) +let _ = M.((* A *) f, f (* B *)) +let _ = M.((* A *) ((f, f) (* B *) [@warning "foo"] (* C *))) + +let _ = + let _ = + Fooooooo. + [ swap_1_c, { minimum_transfert_amount = 0. } + ; swap_2_c, { minimum_transfert_amount = 0. } + ; swap_3_c, { minimum_transfert_amount = 0. } + ] + in + () +;; + +let _ = + match Uri.scheme uri with + | Some _ -> + (* we have an absoluteURI *) + Uri.( + ( match path uri with + | "" -> with_path uri "/" + | _ -> uri + ) + ) +;; + +(* Ptyp_open *) + +let _ : M.(foo * M.(bar)) = () +let _ : M.(foo) * M.(bar) = () +let _ : M.([ `Foo of foo ]) = () +let _ : M.N.(foo) = () + +let _ + : M.( + foooooooooooooooooooooooooooooooooooooooo + * foooooooooooooooooooooooooooooooooooooooo) + = + () +;; + +let _ + : M.( + [ `Foo of + foooooooooooooooooooooooooooooooooooooooo + * foooooooooooooooooooooooooooooooooooooooo + ]) + = + () +;; + +let _ : M.((foo[@attr])) = () +let _ : (M.(foo)[@attr]) = () +let _ : M.((foo[@attr] [@attr])) = () +let _ : (M.((foo[@attr]))[@attr]) = () diff --git a/test/passing/refs.janestreet/open.ml.err b/test/passing/refs.janestreet/open.ml.err new file mode 100644 index 0000000000..cefa32efe0 --- /dev/null +++ b/test/passing/refs.janestreet/open.ml.err @@ -0,0 +1 @@ +Warning: open.ml:39 exceeds the margin diff --git a/test/passing/refs.janestreet/open.ml.ref b/test/passing/refs.janestreet/open.ml.ref new file mode 100644 index 0000000000..fbc815cf3d --- /dev/null +++ b/test/passing/refs.janestreet/open.ml.ref @@ -0,0 +1,370 @@ +let _ = Some_module.Submodule.(a + b) +let _ = A.(a, b) + +let _ = + let open Some_module.Submodule in + AAAAAAAAAAAAAAAAAAAAAAAAAAAA.(a + b) +;; + +let _ = + let open Some_module.Submodule in + let module A = MMMMMM in + a + b + c +;; + +let _ = + let open Some_module.Submodule in + let exception A of int in + a + b +;; + +let _ = + let open Some_module.Submodule in + [%except {| result |}] +;; + +let _ = + let open Some_module.Submodule in + [%except {| loooooooooooooooooooooooooong result |}] +;; + +let _ = + let open Some_module.Submodule in + let x = a + b in + let y = f x in + y +;; + +let () = + ( (let open Term in + term_result (const Phases.phase1 $ arch $ hub_id $ build_dir $ logs_dir $ setup_logs)) + , Term.info "phase1" ~doc ~sdocs:Manpage.s_common_options ~exits ~man ) +;; + +let () = + (let open Arg in + let doc = "Output all." in + value & flag & info [ "all" ] ~doc) + $ + let open Arg in + let doc = "Commit to git." in + value & flag & info [ "commit"; "c" ] ~doc +;; + +let () = + Arg.( + let doc = "Output all." in + value & flag & info [ "all" ] ~doc) + $ Arg.( + let doc = "Commit to git." in + value & flag & info [ "commit"; "c" ] ~doc) +;; + +let () = X.(f y i) +let () = X.(i) + +let () = + let open X in + f y i +;; + +let () = + let open X in + i +;; + +let () = + let open! K in + x y z +;; + +let x = + let Cstruct.{ buffer = bigstring; off = offset; len = length } = + Cstruct.{ toto = foooo } + in + fooooooooo +;; + +open A +open A.B +open A (B) + +open struct + type t +end + +open ( +struct + type t +end : + T) + +open ( +struct + type t +end : +sig + type t +end) + +open (val x) +open (val x) +open [%extension] +open functor (A : T) -> T' + +module type T = sig + open A + open A.B + open A(B) +end + +let x = + let open struct + type t' = t + end in + foo +;; + +let x = + let open struct + open struct + type t = T + end + + let y = T + end in + foo +;; + +let x = + let open struct + open struct + let counter = ref 0 + end + end in + foo +;; + +let x = + let open struct + let open struct + let counter = ref 0 + end in + foo + end in + foo +;; + +let x = + let open struct + module A = struct + open struct + let x = 1 + end + + let y = x + + open struct + let x = 1 + end + + let z = y + x + end + end in + foo +;; + +class type a = + (* A'' *) + let open (* A' *) A (* A *) in + (* B *) + b + +class a = + (* A'' *) + let open (* A' *) A (* A *) in + (* B *) + b + +let _ = + (* a *) + let (* b *) open (* c *) struct + type t + end + (* d *) in + (* e *) + (* f *) + let (* g *) open (* h *) A (* i *) (B) (* j *) in + (* k *) + () +;; + +(* l *) +open (* m *) struct + type t +end +(* n *) + +open A +open B + +open struct + type t +end + +open + functor + (A : S) + -> + struct + type t + end + +open + functor + (_ : S) + -> + struct + type t + end + +open A (B) +open (A : S) +open (val x) +open [%ext] + +let _ = + let open A in + let open B in + let open struct + type t + end in + let open + functor + (A : S) + -> + struct + type t + end in + let open + functor + (_ : S) + -> + struct + type t + end in + let open A (B) in + let open (A : S) in + let open (val x) in + let open [%ext] in + () +;; + +open [@attr] A +open [@attr] B + +open [@attr] struct + type t +end + +open + [@attr] + functor + (A : S) + -> + struct + type t + end + +open + [@attr] + functor + (_ : S) + -> + struct + type t + end + +open [@attr] A (B) +open [@attr] (A : S) +open [@attr] (val x) +open [@attr] [%ext] + +let g = + M.f + ((let open M in + x) [@attr]) +;; + +let _ = M.({ f } [@warning "foo"]) +let _ = M.((* A *) { f }) +let _ = M.({ f } (* B *)) +let _ = M.((* A *) { f } (* B *)) +let _ = M.((* A *) { f } (* B *) [@warning "foo"] (* C *)) +let _ = M.([| f |] [@warning "foo"]) +let _ = M.((* A *) [| f |]) +let _ = M.([| f |] (* B *)) +let _ = M.((* A *) [| f |] (* B *)) +let _ = M.((* A *) [| f |] (* B *) [@warning "foo"] (* C *)) +let _ = M.([ f ] [@warning "foo"]) +let _ = M.((* A *) [ f ]) +let _ = M.([ f ] (* B *)) +let _ = M.([ f ] (* B *)) (* after *) +let _ = M.((* A *) [ f ] (* B *)) +let _ = M.((* A *) [ f ] (* B *) [@warning "foo"] (* C *)) +let _ = M.(((f, f) [@warning "foo"])) +let _ = M.((* A *) f, f) +let _ = M.(f, f (* B *)) +let _ = M.((* A *) f, f (* B *)) +let _ = M.((* A *) ((f, f) (* B *) [@warning "foo"] (* C *))) + +let _ = + let _ = + Fooooooo. + [ swap_1_c, { minimum_transfert_amount = 0. } + ; swap_2_c, { minimum_transfert_amount = 0. } + ; swap_3_c, { minimum_transfert_amount = 0. } + ] + in + () +;; + +let _ = + match Uri.scheme uri with + | Some _ -> + (* we have an absoluteURI *) + Uri.( + (match path uri with + | "" -> with_path uri "/" + | _ -> uri)) +;; + +(* Ptyp_open *) + +let _ : M.(foo * M.(bar)) = () +let _ : M.(foo) * M.(bar) = () +let _ : M.([ `Foo of foo ]) = () +let _ : M.N.(foo) = () + +let _ + : M.( + foooooooooooooooooooooooooooooooooooooooo + * foooooooooooooooooooooooooooooooooooooooo) + = + () +;; + +let _ + : M.( + [ `Foo of + foooooooooooooooooooooooooooooooooooooooo + * foooooooooooooooooooooooooooooooooooooooo + ]) + = + () +;; + +let _ : M.((foo[@attr])) = () +let _ : (M.(foo)[@attr]) = () +let _ : M.((foo[@attr] [@attr])) = () +let _ : (M.((foo[@attr]))[@attr]) = () diff --git a/test/passing/refs.janestreet/open_types.ml.ref b/test/passing/refs.janestreet/open_types.ml.ref new file mode 100644 index 0000000000..cdedac2e82 --- /dev/null +++ b/test/passing/refs.janestreet/open_types.ml.ref @@ -0,0 +1,2 @@ +type t = .. +type sub_system = t = .. diff --git a/test/passing/refs.janestreet/option.ml.err b/test/passing/refs.janestreet/option.ml.err new file mode 100644 index 0000000000..9cad5c9da5 --- /dev/null +++ b/test/passing/refs.janestreet/option.ml.err @@ -0,0 +1,29 @@ +File "option.ml", line 63, characters 17-28: +63 | [@@@ocamlformat "margin=90"] + ^^^^^^^^^^^ +Warning 47 [attribute-payload]: illegal payload for attribute 'ocamlformat'. +margin not allowed here + +File "option.ml", line 13, characters 3-19: +13 | [@@ocamlformat.typo "if-then-else=keyword-first"] + ^^^^^^^^^^^^^^^^ +Warning 47 [attribute-payload]: illegal payload for attribute 'ocamlformat.typo'. +Invalid format: Unknown suffix "typo" + +File "option.ml", line 21, characters 3-14: +21 | [@@ocamlformat 1, "if-then-else=keyword-first"] + ^^^^^^^^^^^ +Warning 47 [attribute-payload]: illegal payload for attribute 'ocamlformat'. +Invalid format: String expected + +File "option.ml", line 28, characters 3-14: +28 | [@@ocamlformat "if-then-else=bad"] + ^^^^^^^^^^^ +Warning 47 [attribute-payload]: illegal payload for attribute 'ocamlformat'. +For option "if-then-else": invalid value 'bad', expected one of 'compact', 'fit-or-vertical', 'vertical', 'keyword-first' or 'k-r' + +File "option.ml", line 39, characters 14-25: +39 | [@@ocamlformat "if-then-else=bad"] + ^^^^^^^^^^^ +Warning 47 [attribute-payload]: illegal payload for attribute 'ocamlformat'. +For option "if-then-else": invalid value 'bad', expected one of 'compact', 'fit-or-vertical', 'vertical', 'keyword-first' or 'k-r' diff --git a/test/passing/refs.janestreet/option.ml.ref b/test/passing/refs.janestreet/option.ml.ref new file mode 100644 index 0000000000..35a437211b --- /dev/null +++ b/test/passing/refs.janestreet/option.ml.ref @@ -0,0 +1,75 @@ +let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +[@@ocamlformat "if-then-else=keyword-first"] +;; + +let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +[@@ocamlformat.typo "if-then-else=keyword-first"] +;; + +let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +[@@ocamlformat 1, "if-then-else=keyword-first"] +;; + +let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) +[@@ocamlformat "if-then-else=bad"] +;; + +module M = struct + [@@@ocamlformat "if-then-else=keyword-first"] + + let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + [@@ocamlformat "if-then-else=bad"] + ;; + + let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + ;; + + let _ = + if b + then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + ;; + + [@@@ocamlformat "if-then-else=compact"] + + let _ = + if b then e + else ( + something loooooooooooooooooooooooooooooooong enough to_trigger a break; + this is more) + ;; +end + +[@@@ocamlformat "margin=90"] diff --git a/test/passing/refs.janestreet/override.ml.ref b/test/passing/refs.janestreet/override.ml.ref new file mode 100644 index 0000000000..c542af8e09 --- /dev/null +++ b/test/passing/refs.janestreet/override.ml.ref @@ -0,0 +1,5 @@ +let _ = {<x = (x : t)>} +let _ = {<x = ((x [@a]) : (t[@b])) [@c]>} +let _ = {<x>} +let _ = {<x = x [@a]>} +let _ = {<x>} diff --git a/test/passing/refs.janestreet/parens_tuple_patterns.ml.ref b/test/passing/refs.janestreet/parens_tuple_patterns.ml.ref new file mode 100644 index 0000000000..d4c90fb0aa --- /dev/null +++ b/test/passing/refs.janestreet/parens_tuple_patterns.ml.ref @@ -0,0 +1,5 @@ +let a, b = 1, 2 +let[@ocamlformat "parens-tuple-patterns=always"] (a, b) = 1, 2 +let[@ocamlformat "parens-tuple-patterns=always"] M.(a, b) = () +let[@ocamlformat "parens-tuple-patterns=multi-line-only"] a, b = 1, 2 +let[@ocamlformat "parens-tuple-patterns=multi-line-only"] M.(a, b) = () diff --git a/test/passing/refs.janestreet/polytypes.ml.err b/test/passing/refs.janestreet/polytypes.ml.err new file mode 100644 index 0000000000..442a661d73 --- /dev/null +++ b/test/passing/refs.janestreet/polytypes.ml.err @@ -0,0 +1 @@ +Warning: polytypes.ml:48 exceeds the margin diff --git a/test/passing/tests/polytypes-janestreet.ml.ref b/test/passing/refs.janestreet/polytypes.ml.ref similarity index 100% rename from test/passing/tests/polytypes-janestreet.ml.ref rename to test/passing/refs.janestreet/polytypes.ml.ref diff --git a/test/passing/refs.janestreet/pre_post_extensions.ml.ref b/test/passing/refs.janestreet/pre_post_extensions.ml.ref new file mode 100644 index 0000000000..e8e8160e42 --- /dev/null +++ b/test/passing/refs.janestreet/pre_post_extensions.ml.ref @@ -0,0 +1,17 @@ +let f x = + [%Trace.call fun { pf } -> pf "%i" x] + ; + print_int x ; + x + |> + [%Trace.retn fun { pf } -> pf "%i"] +;; + +let f x = + [%Trace.call fun { pf } : t -> pf "%i" x] + ; + print_int x ; + x + |> + [%Trace.retn fun { pf } : t -> pf "%i"] +;; diff --git a/test/passing/refs.janestreet/precedence.ml.ref b/test/passing/refs.janestreet/precedence.ml.ref new file mode 100644 index 0000000000..827acb39d7 --- /dev/null +++ b/test/passing/refs.janestreet/precedence.ml.ref @@ -0,0 +1,3 @@ +a || (b && c);; +1 + (3 * 5);; +1 < 3 || b diff --git a/test/passing/refs.janestreet/prefix_infix.ml.ref b/test/passing/refs.janestreet/prefix_infix.ml.ref new file mode 100644 index 0000000000..aa15135f2f --- /dev/null +++ b/test/passing/refs.janestreet/prefix_infix.ml.ref @@ -0,0 +1,15 @@ +let _ = List.filter (( != ) e) l +let _ = List.map (( != ) x) l +let _ = x != y +let _ = - !e +let _ = - !e.f +let z = (( ! ) ~x:4) 1 2 ~c:3 +let z = (( ! ) ~x:4 y z) 1 2 ~c:3 +let z = (( ! ) ~x:4 [@attr]) 1 2 ~c:3 +let z = (( ! ) [@attr]) 1 2 ~c:3 +let z = ( ! ) [@attr] +let i x = (!r [@attr]) x +let _ = ( * ) [@attr] +let _ = f (( * ) [@attr]);; + +( * ) [@attr] diff --git a/test/passing/refs.janestreet/profiles.ml.ref b/test/passing/refs.janestreet/profiles.ml.ref new file mode 100644 index 0000000000..c793dafabe --- /dev/null +++ b/test/passing/refs.janestreet/profiles.ml.ref @@ -0,0 +1,9 @@ +let a = + aaaaaaaaaa + aaaaaaaaa +;; + +let b = + bbbbbbbbbb + bbbbbbbbb +;; diff --git a/test/passing/refs.janestreet/profiles2.ml.ref b/test/passing/refs.janestreet/profiles2.ml.ref new file mode 100644 index 0000000000..62e8249d13 --- /dev/null +++ b/test/passing/refs.janestreet/profiles2.ml.ref @@ -0,0 +1,2 @@ +let a = aaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaa +let b = bbbbbbbbbbbbbbbbbbvvbbb bbbvvvbbbbbbbbbbbbbbbbbbbb bbbbbbbbbbbbbbbbbbbbbb diff --git a/test/passing/refs.janestreet/protected_object_types.ml.ref b/test/passing/refs.janestreet/protected_object_types.ml.ref new file mode 100644 index 0000000000..013d51ee1f --- /dev/null +++ b/test/passing/refs.janestreet/protected_object_types.ml.ref @@ -0,0 +1,86 @@ +(* Tests of special cases added to avoid emitting [>\] and [>\}], which are + keywords. *) + +(* Regression tests for https://github.com/ocaml-ppx/ocamlformat/issues/1295 + (unnecessary trailing spaces added after object types with attributes). *) + +type t = { foo : (< .. >[@a]) } +type t = { foo : < .. > [@a] } +type t = A of { foo : (< .. >[@a]) } +type t = A of { foo : < .. > [@a] } +type t = [ `Foo of (< .. >[@a]) ] +type t = [ `Foo of < .. > [@a] ] + +let _ = + object + inherit [b, (< f : unit >[@a])] foo + end +;; + +module Space_around = struct + (* Ensure that the protection mechanism does not add extra spaces when + [--space-around-*] options are sufficient. *) + + module Records = struct + type t = { foo : < .. > } + type t = A of { foo : < .. > } + end + [@@ocamlformat "space-around-records = true"] + + module Variants = struct + type t = [ `Foo of < .. > ] + end + [@@ocamlformat "space-around-variants"] +end + +module Inside_payloads = struct + (* Regression tests for + https://github.com/ocaml-ppx/ocamlformat/issues/1267 (failure to protect + against object types inside extension and attribute payloads). *) + + let _ = [%ext: < .. > ] + + [%%ext: < .. > ] + + [%%ext + () + + type a = < f : t > ] + + [@@@a: val b : < .. > ] + + let _ = () [@a: val b : < .. > ] + let _ = () [@@a: val b : < .. > ] + + [@@@a: type x = < .. > ] + + [@@@a: + val x : t + + type x = < .. > ] + + [@@@a: type t = < .. > ] + [@@@a: type t = (< .. >[@a])] + + [@@@a: + type a = + | A of t + | B of t + | C of < .. > ] + + [@@@a: + type a = + | A of t + | B of t + | C of (t -> < .. >)] + + [@@@a: type a += C of a * b * < .. > ] + [@@@a: type a += C of a * b * < .. > [@a]] + [@@@a: type a += C of (a -> b * < .. >)] + [@@@a: type a = t constraint t = < .. > ] + [@@@a: type a = t constraint t = (< .. >[@a])] + [@@@a: exception C of a * b * < .. > ] + + (* Simple attributes on exceptions not supported pre-4.08 *) + [@@@a: exception C of a * b * < .. > [@@a]] +end diff --git a/test/passing/refs.janestreet/qtest.ml.err b/test/passing/refs.janestreet/qtest.ml.err new file mode 100644 index 0000000000..1a25e98fce --- /dev/null +++ b/test/passing/refs.janestreet/qtest.ml.err @@ -0,0 +1 @@ +Warning: qtest.ml:21 exceeds the margin diff --git a/test/passing/refs.janestreet/qtest.ml.ref b/test/passing/refs.janestreet/qtest.ml.ref new file mode 100644 index 0000000000..7515b70aea --- /dev/null +++ b/test/passing/refs.janestreet/qtest.ml.ref @@ -0,0 +1,59 @@ +(*$T + false +*) + +(*$T foo + foo 0 ( + ) [1;2;3] = 6 (* hehe *) + foo 0 ( * ) [1;2;3] = 0 (* haha (*hoho *) *) + foo 1 ( * ) [4;5] = 20 + foo 12 ( + ) [] = 12 +*) + +(*$T foo + foo 1 ( * ) [4;5] = foo 2 ( * ) [1;5;2] +*) + +(*$= foo & ~printer:string_of_int + (foo 1 ( * ) [4;5]) (foo 2 ( * ) [1;5;2]) +*) + +(*$Q foo + Q.small_int (fun i-> foo i (+) [1;2;3] = List.fold_left (+) i [1;2;3]) + (Q.pair Q.small_int (Q.list Q.small_int)) (fun (i,l)-> foo i (+) l = List.fold_left (+) i l) +*) + +(*$R foo + let thing = foo 1 ( * ) + and li = [4;5] in + assert_bool "something_witty" (thing li = 20); + (* pertinent comment *) + assert_bool "something_wittier" (1=1) +*) + +(*$inject let brom = baz *) +(*$T brom + brom.[2] = 'z' +*) + +(*$T & + 1 = 2-1 + 2+3 \ + = \ + \ + 5 + + 1+1=2 +*) + +(*$T & 6 \ + & = + 2*3 +*) + +(*$Q & ~count:10 + (Q.small_int_corners ()) (fun n-> n+3 -2 -1 = abs n) +*) + +(*$Q & ~max_gen:1000000 ~count:1000000 + (Q.make (fun _ -> ())) (fun () -> true) +*) diff --git a/test/passing/refs.janestreet/quoted_strings.ml.ref b/test/passing/refs.janestreet/quoted_strings.ml.ref new file mode 100644 index 0000000000..599dd58316 --- /dev/null +++ b/test/passing/refs.janestreet/quoted_strings.ml.ref @@ -0,0 +1,38 @@ +let foo = {%foo| foooooooooooooo |} +let foo = (* A *) {%foo| foooooooooooooo |} (* B *) [@attr] (* C *) +let foo = (* A *) {%foo sep| foooooooooooooo |sep} +let foo = {%foo| foooooooooooooo |} [@@attr] +let foo = {%foo| foooooooooooooo |} (* A *) [@@attr] (* B *) +let foo = {%foo| foooooooooooooo |} [@attr] [@@attr] +let foo = {%foo| foooooooooooooo |} (* A *) [@attr] (* B *) [@@attr] +let foo = (* A *) {%foo| foooooooooooooo |} [@attr] (* B *) [@@attr] +let foo = (* A *) {%foo sep| foooooooooooooo |sep} (* B *) [@@attr] + +{%%foo| foooooooooooooo |} +{%%foo| foooooooooooooo |} (* A *) [@@attr] (* B *) +{%%foo sep| foooooooooooooo |sep} +{%%foo sep| foooooooooooooo |sep} (* A *) [@@attr] + +(* Structures *) +{%%M.foo| <hello>{x} |} +{%%M.foo bar| <hello>{|x|} |bar} + +(* Signatures *) +module type S = sig + {%%M.foo| <hello>{x} |} + {%%M.foo bar| <hello>{|x|} |bar} +end + +(* Expressions/Pattern/Types *) +let ({%M.foo| <hello>{x} |} : {%M.foo| <hello>{x} |}) = {%M.foo| <hello>{x} |} + +let ({%M.foo bar| <hello>{|x|} |bar} : {%M.foo bar| <hello>{|x|} |bar}) = + {%M.foo bar| <hello>{|x|} |bar} +;; + +(* Multiline *) +{%%M.foo| + <hello> + {x} + </hello> +|} diff --git a/test/passing/refs.janestreet/recmod.mli.ref b/test/passing/refs.janestreet/recmod.mli.ref new file mode 100644 index 0000000000..b1beda2c6a --- /dev/null +++ b/test/passing/refs.janestreet/recmod.mli.ref @@ -0,0 +1,19 @@ +module rec A : sig + type t = AA of B.t +end + +and B : sig + type t = BB of A.t +end + +include sig + (* a *) +end + +module type S = sig end + +(** A *) +module rec A : S + +(** B *) +and B : S diff --git a/test/passing/refs.janestreet/record-402.ml.err b/test/passing/refs.janestreet/record-402.ml.err new file mode 100644 index 0000000000..411bf6353d --- /dev/null +++ b/test/passing/refs.janestreet/record-402.ml.err @@ -0,0 +1,2 @@ +Warning: record-402.ml:10 exceeds the margin +Warning: record-402.ml:18 exceeds the margin diff --git a/test/passing/refs.janestreet/record-402.ml.ref b/test/passing/refs.janestreet/record-402.ml.ref new file mode 100644 index 0000000000..4a244935f2 --- /dev/null +++ b/test/passing/refs.janestreet/record-402.ml.ref @@ -0,0 +1,101 @@ +type t = + { x : int + ; y : int + } + +let _ = { x = 1; y = 2 } +let _ = { !e with a; b = c } +let _ = { !(f e) with a; b = c } + +let _ = + { !looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + with + a + ; b = c + } +;; + +let _ = + { !looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + with + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + ; b = c + } +;; + +let _ = { (a : t) with a; b; c } +let _ = { (f a) with a; b; c } + +let _ = + { (a; + a) + with + a + ; b + ; c + } +;; + +let _ = { (if x then e else e) with e1; e2 } + +let _ = + { (match x with + | x -> e) + with + e1 + ; e2 + } +;; + +let _ = { (x : x) with e1; e2 } +let _ = { (x :> x) with e1; e2 } +let _ = { (x#x) with e1; e2 } +let f ~l:{ f; g } = e +let f ?l:({ f; g }) = e + +let _ = + { a + ; b = + ((match b with + | `A -> A + | `B -> B + | `C -> C) + : c) + ; c + } +;; + +let a () = A { A.a = (a : t) } +let x = { aaaaaaaaaa (* b *); b } +let x = { aaaaaaaaaa (* b *); b } + +type t = + { a : (module S) + ; b : (module S) + } + +let _ = { a = (module M : S); b = (module M : S) } +let to_string { x; _ (* we should print y *) } = string_of_int x +let { x = (x : t) } = x + +type t = + { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : + YYYYYYYYYYYYYYYYYYYYY.t + (* ____________________________________ *) + } + +let _ = + let _ = function + | { foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + ; foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + } -> () + in + () +;; + +let foo + ({ foooooooooooooooooooooo; invalidation_trace; access_trace; must_be_valid_reason } + [@warning "+missing-record-field-pattern"]) + = + () +;; diff --git a/test/passing/refs.janestreet/record-loose.ml.err b/test/passing/refs.janestreet/record-loose.ml.err new file mode 100644 index 0000000000..2dae75a02f --- /dev/null +++ b/test/passing/refs.janestreet/record-loose.ml.err @@ -0,0 +1,2 @@ +Warning: record-loose.ml:10 exceeds the margin +Warning: record-loose.ml:18 exceeds the margin diff --git a/test/passing/refs.janestreet/record-loose.ml.ref b/test/passing/refs.janestreet/record-loose.ml.ref new file mode 100644 index 0000000000..c26a4dcee5 --- /dev/null +++ b/test/passing/refs.janestreet/record-loose.ml.ref @@ -0,0 +1,101 @@ +type t = + { x : int + ; y : int + } + +let _ = { x = 1; y = 2 } +let _ = { !e with a; b = c } +let _ = { !(f e) with a; b = c } + +let _ = + { !looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + with + a + ; b = c + } +;; + +let _ = + { !looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + with + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + ; b = c + } +;; + +let _ = { (a : t) with a; b; c } +let _ = { (f a) with a; b; c } + +let _ = + { (a; + a) + with + a + ; b + ; c + } +;; + +let _ = { (if x then e else e) with e1; e2 } + +let _ = + { (match x with + | x -> e) + with + e1 + ; e2 + } +;; + +let _ = { (x : x) with e1; e2 } +let _ = { (x :> x) with e1; e2 } +let _ = { (x#x) with e1; e2 } +let f ~l:{ f; g } = e +let f ?l:({ f; g }) = e + +let _ = + { a + ; b = + ((match b with + | `A -> A + | `B -> B + | `C -> C) + : c) + ; c + } +;; + +let a () = A { A.a : t } +let x = { aaaaaaaaaa (* b *); b } +let x = { aaaaaaaaaa (* b *); b } + +type t = + { a : (module S) + ; b : (module S) + } + +let _ = { a = (module M : S); b = (module M : S) } +let to_string { x; _ (* we should print y *) } = string_of_int x +let { x : t } = x + +type t = + { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : + YYYYYYYYYYYYYYYYYYYYY.t + (* ____________________________________ *) + } + +let _ = + let _ = function + | { foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + ; foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + } -> () + in + () +;; + +let foo + ({ foooooooooooooooooooooo; invalidation_trace; access_trace; must_be_valid_reason } + [@warning "+missing-record-field-pattern"]) + = + () +;; diff --git a/test/passing/refs.janestreet/record-tight_decl.ml.err b/test/passing/refs.janestreet/record-tight_decl.ml.err new file mode 100644 index 0000000000..4999d6f76e --- /dev/null +++ b/test/passing/refs.janestreet/record-tight_decl.ml.err @@ -0,0 +1,2 @@ +Warning: record-tight_decl.ml:10 exceeds the margin +Warning: record-tight_decl.ml:18 exceeds the margin diff --git a/test/passing/refs.janestreet/record-tight_decl.ml.ref b/test/passing/refs.janestreet/record-tight_decl.ml.ref new file mode 100644 index 0000000000..7578f3347a --- /dev/null +++ b/test/passing/refs.janestreet/record-tight_decl.ml.ref @@ -0,0 +1,101 @@ +type t = + { x: int + ; y: int + } + +let _ = { x = 1; y = 2 } +let _ = { !e with a; b = c } +let _ = { !(f e) with a; b = c } + +let _ = + { !looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + with + a + ; b = c + } +;; + +let _ = + { !looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + with + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + ; b = c + } +;; + +let _ = { (a : t) with a; b; c } +let _ = { (f a) with a; b; c } + +let _ = + { (a; + a) + with + a + ; b + ; c + } +;; + +let _ = { (if x then e else e) with e1; e2 } + +let _ = + { (match x with + | x -> e) + with + e1 + ; e2 + } +;; + +let _ = { (x : x) with e1; e2 } +let _ = { (x :> x) with e1; e2 } +let _ = { (x#x) with e1; e2 } +let f ~l:{ f; g } = e +let f ?l:({ f; g }) = e + +let _ = + { a + ; b = + ((match b with + | `A -> A + | `B -> B + | `C -> C) + : c) + ; c + } +;; + +let a () = A { A.a : t } +let x = { aaaaaaaaaa (* b *); b } +let x = { aaaaaaaaaa (* b *); b } + +type t = + { a: (module S) + ; b: (module S) + } + +let _ = { a = (module M : S); b = (module M : S) } +let to_string { x; _ (* we should print y *) } = string_of_int x +let { x : t } = x + +type t = + { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx: + YYYYYYYYYYYYYYYYYYYYY.t + (* ____________________________________ *) + } + +let _ = + let _ = function + | { foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + ; foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + } -> () + in + () +;; + +let foo + ({ foooooooooooooooooooooo; invalidation_trace; access_trace; must_be_valid_reason } + [@warning "+missing-record-field-pattern"]) + = + () +;; diff --git a/test/passing/refs.janestreet/record.ml.err b/test/passing/refs.janestreet/record.ml.err new file mode 100644 index 0000000000..f9bd649e8f --- /dev/null +++ b/test/passing/refs.janestreet/record.ml.err @@ -0,0 +1,2 @@ +Warning: record.ml:10 exceeds the margin +Warning: record.ml:18 exceeds the margin diff --git a/test/passing/refs.janestreet/record.ml.ref b/test/passing/refs.janestreet/record.ml.ref new file mode 100644 index 0000000000..bd3b7cf756 --- /dev/null +++ b/test/passing/refs.janestreet/record.ml.ref @@ -0,0 +1,101 @@ +type t = + { x: int + ; y: int + } + +let _ = { x= 1; y= 2 } +let _ = { !e with a; b= c } +let _ = { !(f e) with a; b= c } + +let _ = + { !looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + with + a + ; b= c + } +;; + +let _ = + { !looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + with + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + ; b= c + } +;; + +let _ = { (a : t) with a; b; c } +let _ = { (f a) with a; b; c } + +let _ = + { (a; + a) + with + a + ; b + ; c + } +;; + +let _ = { (if x then e else e) with e1; e2 } + +let _ = + { (match x with + | x -> e) + with + e1 + ; e2 + } +;; + +let _ = { (x : x) with e1; e2 } +let _ = { (x :> x) with e1; e2 } +let _ = { (x#x) with e1; e2 } +let f ~l:{ f; g } = e +let f ?l:({ f; g }) = e + +let _ = + { a + ; b= + ((match b with + | `A -> A + | `B -> B + | `C -> C) + : c) + ; c + } +;; + +let a () = A { A.a: t } +let x = { aaaaaaaaaa (* b *); b } +let x = { aaaaaaaaaa (* b *); b } + +type t = + { a: (module S) + ; b: (module S) + } + +let _ = { a= (module M : S); b= (module M : S) } +let to_string { x; _ (* we should print y *) } = string_of_int x +let { x: t } = x + +type t = + { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx: + YYYYYYYYYYYYYYYYYYYYY.t + (* ____________________________________ *) + } + +let _ = + let _ = function + | { foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + ; foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + } -> () + in + () +;; + +let foo + ({ foooooooooooooooooooooo; invalidation_trace; access_trace; must_be_valid_reason } + [@warning "+missing-record-field-pattern"]) + = + () +;; diff --git a/test/passing/tests/record_punning-js.ml.ref b/test/passing/refs.janestreet/record_punning.ml.ref similarity index 100% rename from test/passing/tests/record_punning-js.ml.ref rename to test/passing/refs.janestreet/record_punning.ml.ref diff --git a/test/passing/refs.janestreet/reformat_string.ml.ref b/test/passing/refs.janestreet/reformat_string.ml.ref new file mode 100644 index 0000000000..3f18d10673 --- /dev/null +++ b/test/passing/refs.janestreet/reformat_string.ml.ref @@ -0,0 +1,14 @@ +let _ = 'a' +let _ = 'a' +let _ = (* test *) "asd" +let _ = "asd" +let _ = (* te""st *) "asd" +let _ = "asd" +let _ = 'a' +let _ = 'a' + +let _ = function + | 'a' .. 'z' -> () +;; + +let _ = "aaa\n\n e" diff --git a/test/passing/refs.janestreet/refs.ml.ref b/test/passing/refs.janestreet/refs.ml.ref new file mode 100644 index 0000000000..70a647973a --- /dev/null +++ b/test/passing/refs.janestreet/refs.ml.ref @@ -0,0 +1,13 @@ +let _ = + x := 2; + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx := 2; + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + := something very looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong; + xxxxxxxxxxxxx xxxxxxxxxxx xxxxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx xxxxxxxxxx xxxxxxxxxxxxx + := something very looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong; + xx := something very loooooooooooooooooooooooooooooooooooooooooooooooooooooooong; + if something loooooooooooong + then xx := something very loooooooooooooooooooooooooooooooooooooooooooooooooooooooong +;; + +if row <> row' && col <> col' then b.(row').(col') <- remove b.(row').(col') value diff --git a/test/passing/refs.janestreet/remove_extra_parens.ml.ref b/test/passing/refs.janestreet/remove_extra_parens.ml.ref new file mode 100644 index 0000000000..9c384bb67f --- /dev/null +++ b/test/passing/refs.janestreet/remove_extra_parens.ml.ref @@ -0,0 +1,3 @@ +let f = function + | [ { xxxxxx }; { yyyyyyyy } ] -> () +;; diff --git a/test/passing/refs.janestreet/repl.ml.ref b/test/passing/refs.janestreet/repl.ml.ref new file mode 100644 index 0000000000..844b84c25b --- /dev/null +++ b/test/passing/refs.janestreet/repl.ml.ref @@ -0,0 +1,8 @@ +# let x = 2;; +val x : int = 2 +# x + 2;; +- : int = 4 +# let x = 2 + and y = 3 in + x + y + ;; diff --git a/test/passing/refs.janestreet/repl.mli.ref b/test/passing/refs.janestreet/repl.mli.ref new file mode 100644 index 0000000000..967a38e238 --- /dev/null +++ b/test/passing/refs.janestreet/repl.mli.ref @@ -0,0 +1,99 @@ +(** VALID BLOCKS: + + Block delimiters should be on their own line: + {[ let x = 1 ]} + + As of odoc 2.1, a block can carry metadata: + {@ocaml[ + let x = 2 + ]} + + An OCaml block that should break: + {[ + let x = 2 in x + x + ]} + + A toplevel phrase with no output: + {[ + # let x = 2 and y = 3 in x+y;; + ]} + + A toplevel phrase with output: + {@ocaml[ + # let x = 2;; + val x : int = 2 + ]} + + Many toplevel phrases without output: + {[ + # let x = 2;; + # x + 2;; + # let x = 2 and y = 3 in x+y;; + ]} + + Many toplevel phrases with output: + {[ + # let x = 2;; + val x : int = 2 + # x + 2;; + - : int = 4 + # let x = 2 and y = 3 in x+y;; + ]} + + Output are printed after a newline: + {[ + # let x = 2;; val x : int = 2 + # let x = 3;; + # let x = 4;; val x : int = 4 + ]} + + Excessive linebreaks are removed: + {[ + + # let x = 2 in x+1;; + + output + + # let y = 3 in y+1;; + + ]} + + Linebreak after `#`: + {[ + # + let x = 2 in x+1;; + ]} +*) +type t = k + +(** INVALID BLOCKS: The formatting of invalid blocks is preserved. + + Invalid toplevel phrase/ocaml block: + {[ + - : int = + 4 + ]} + + Output before a toplevel phrase: + {[ + - : int = 4 + # 2+2;; + ]} + + No `;;` at the end of the phrase, no output: + {[ + # let x = 2 in x+1 + ]} + + No `;;` at the end of the phrase, with output: + {[ + # let x = 2 in x+1 + some output + ]} + + Multiple phrases without `;;` at the end: + {[ + # let x = 2 in x+1 + # let x = 4 in x+1 + ]} +*) diff --git a/test/passing/refs.janestreet/revapply_ext.ml.ref b/test/passing/refs.janestreet/revapply_ext.ml.ref new file mode 100644 index 0000000000..cf57e78006 --- /dev/null +++ b/test/passing/refs.janestreet/revapply_ext.ml.ref @@ -0,0 +1,10 @@ +let _ = + () + (* one *) + |> + [%ext fun _ -> ()] +;; + +let _ = () + |> + [%ext fun _ -> ()] diff --git a/test/passing/refs.janestreet/send.ml.ref b/test/passing/refs.janestreet/send.ml.ref new file mode 100644 index 0000000000..68ad60950a --- /dev/null +++ b/test/passing/refs.janestreet/send.ml.ref @@ -0,0 +1,12 @@ +let x obj = obj#hello () +let x obj_f = (obj_f ())#hello () +let f obj = obj#hello_some_pretty_long_one ~with_labels:true () + +let f obj = + obj#hello_some_pretty_long_one + ~with_labels:true + "desjd\ndijsde\n" + {md| +In **markdown** +|md} +;; diff --git a/test/passing/refs.janestreet/sequence-preserve.ml.ref b/test/passing/refs.janestreet/sequence-preserve.ml.ref new file mode 100644 index 0000000000..b82bfbdab6 --- /dev/null +++ b/test/passing/refs.janestreet/sequence-preserve.ml.ref @@ -0,0 +1,163 @@ +let read_traces filename = + let ic = open_in_bin filename in + read_hashtable ~t:[%t: contracts_trace] 0 40 ic tbl1; + read_hashtable ~t:[%t: variables_trace] 40 70 ic tbl2; + read_hashtable ~t:[%t: expressions_trace] 70 100 ic tbl3; + close_in ic +;; + +let foo x y = + do_some_setup y; + do_some_setup y; + + do_some_setup y; + do_some_setup y; + important_function x +;; + +let foo x y = + do_some_setup y; + important_function x +;; + +let foo x y = + do_some_setup y; + + important_function x +;; + +let foo x y = + do_some_setup x; + do_some_setup y; + + (* Empty line before *) + important_function x; + another_important_function x y; + + cleanup x y +;; + +let foo x y = + do_some_setup x; + do_some_setup y; + (* No empty line *) + important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + do_some_setup x; + do_some_setup y; + + (* Empty line after *) + important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + do_some_setup x; + do_some_setup y; + + (* Empty line after, this above *) + important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + do_some_setup x; + do_some_setup y; + + (* Empty line before, this under *) important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + (* Break should not cause an empty line *) + do_some_setup x; + do_some_setup y; + + important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + do_some_setup x; + let () = do_some_setup y in + (* Empty line after let *) + + important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + do_some_setup x; + let () = do_some_setup y in + + (* Empty line after let but before comment *) + important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + (* in should not cause an empty line *) + let () = do_some_setup x in + do_some_setup y; + + important_function x; + another_important_function x y; + cleanup x y +;; + +let _ = + some statement; + (* comment with an empty line in it + + tricky *) + an other statement +;; + +let foo x y = + do_some_setup x; + let* () = do_some_setup y in + + (* Empty line after letop *) + important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + (* letop in should not cause an empty line *) + let* () = do_some_setup x in + do_some_setup y; + + important_function x; + another_important_function x y; + cleanup x y +;; + +let _ = + (* This let will wrap *) + let x = 1 in + + (* some comment *) + next statement +;; + +[@@@ocamlformat "indicate-multiline-delimiters=closing-on-separate-line"] + +let foo x y = + lazy + ( fooooooooooooooooooooooo; + fooooooooooooooooooooooo; + foooooooooooooooooooooooooo; + fooooooooooooooooooooooooo + ) +;; diff --git a/test/passing/refs.janestreet/sequence.ml.ref b/test/passing/refs.janestreet/sequence.ml.ref new file mode 100644 index 0000000000..29f1bafcce --- /dev/null +++ b/test/passing/refs.janestreet/sequence.ml.ref @@ -0,0 +1,149 @@ +let read_traces filename = + let ic = open_in_bin filename in + read_hashtable ~t:[%t: contracts_trace] 0 40 ic tbl1; + read_hashtable ~t:[%t: variables_trace] 40 70 ic tbl2; + read_hashtable ~t:[%t: expressions_trace] 70 100 ic tbl3; + close_in ic +;; + +let foo x y = + do_some_setup y; + do_some_setup y; + do_some_setup y; + do_some_setup y; + important_function x +;; + +let foo x y = + do_some_setup y; + important_function x +;; + +let foo x y = + do_some_setup y; + important_function x +;; + +let foo x y = + do_some_setup x; + do_some_setup y; + (* Empty line before *) + important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + do_some_setup x; + do_some_setup y; + (* No empty line *) + important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + do_some_setup x; + do_some_setup y; + (* Empty line after *) + important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + do_some_setup x; + do_some_setup y; + (* Empty line after, this above *) + important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + do_some_setup x; + do_some_setup y; + (* Empty line before, this under *) important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + (* Break should not cause an empty line *) + do_some_setup x; + do_some_setup y; + important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + do_some_setup x; + let () = do_some_setup y in + (* Empty line after let *) + important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + do_some_setup x; + let () = do_some_setup y in + (* Empty line after let but before comment *) + important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + (* in should not cause an empty line *) + let () = do_some_setup x in + do_some_setup y; + important_function x; + another_important_function x y; + cleanup x y +;; + +let _ = + some statement; + (* comment with an empty line in it + + tricky *) + an other statement +;; + +let foo x y = + do_some_setup x; + let* () = do_some_setup y in + (* Empty line after letop *) + important_function x; + another_important_function x y; + cleanup x y +;; + +let foo x y = + (* letop in should not cause an empty line *) + let* () = do_some_setup x in + do_some_setup y; + important_function x; + another_important_function x y; + cleanup x y +;; + +let _ = + (* This let will wrap *) + let x = 1 in + (* some comment *) + next statement +;; + +[@@@ocamlformat "indicate-multiline-delimiters=closing-on-separate-line"] + +let foo x y = + lazy + ( fooooooooooooooooooooooo; + fooooooooooooooooooooooo; + foooooooooooooooooooooooooo; + fooooooooooooooooooooooooo + ) +;; diff --git a/test/passing/refs.janestreet/shebang.ml.ref b/test/passing/refs.janestreet/shebang.ml.ref new file mode 100644 index 0000000000..4e322b9f6f --- /dev/null +++ b/test/passing/refs.janestreet/shebang.ml.ref @@ -0,0 +1,8 @@ +#!/usr/bin/env ocaml + +type t = + { a : a + ; b : b + } + +let f x = x diff --git a/test/passing/refs.janestreet/shortcut_ext_attr.ml.ref b/test/passing/refs.janestreet/shortcut_ext_attr.ml.ref new file mode 100644 index 0000000000..0efb98caf8 --- /dev/null +++ b/test/passing/refs.janestreet/shortcut_ext_attr.ml.ref @@ -0,0 +1,131 @@ +(* Expressions *) +let () = + let%foo[@foo] x = 3 + and[@foo] y = 4 in + [%foo + (let module M = M in + ()) + [@foo]]; + [%foo M.(()) [@foo]]; + [%foo fun [@foo] x -> ()]; + [%foo + function[@foo] + | x -> ()]; + [%foo + try[@foo] () with + | _ -> ()]; + [%foo if [@foo] () then () else ()]; + [%foo + while () do + () + done + [@foo]]; + [%foo + for x = () to () do + () + done + [@foo]]; + ();%foo + (); + [%foo assert true [@foo]]; + [%foo lazy x [@foo]]; + [%foo object end [@foo]]; + [%foo (3 [@foo])]; + [%foo new x [@foo]]; + [%foo + match[@foo] () with + | [%foo? + (* Pattern expressions *) + ((lazy x) [@foo])] -> () + | [%foo? ((exception x) [@foo])] -> ()] +;; + +(* Class expressions *) +class x = + fun [@foo] x -> + let[@foo] x = 33 in + object + inherit x [@@foo] + val x = 333 [@@foo] + val virtual x : t [@@foo] + val! mutable x = 3 [@@foo] + method x = 3 [@@foo] + method virtual x : t [@@foo] + method! private x = 3 [@@foo] + initializer x [@@foo] + end + [@foo] + +(* Class type expressions *) +class type t = object + inherit t [@@foo] + val x : t [@@foo] + val mutable x : t [@@foo] + method x : t [@@foo] + method private x : t [@@foo] + constraint t = t' [@@foo] +end[@foo] + +(* Type expressions *) +type t = [%foo: ((module M)[@foo])] + +(* Module expressions *) +module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo])) + +(* Module type expression *) +module type S = functor [@foo1] + (M : S) + -> functor + (_ : (module type of M) [@foo2]) + -> sig end [@foo3] + +(* Structure items *) +let%foo[@foo] x = 4 +and[@foo] y = x + +type%foo t = int [@@foo] +and t = int [@@foo] + +type%foo t += T [@@foo] + +class%foo x = x [@@foo] + +class type%foo x = x [@@foo] + +external%foo x : _ = "" [@@foo] + +exception%foo X [@@foo] + +module%foo M = M [@@foo] + +module%foo rec M : S = M [@@foo] +and M : S = M [@@foo] + +module type%foo S = S [@@foo] + +include%foo M [@@foo] +open%foo M [@@foo] + +(* Signature items *) +module type S = sig + [%%foo: val x : t [@@foo]] + [%%foo: external x : t = "" [@@foo]] + + type%foo t = int [@@foo] + and t' = int [@@foo] + + [%%foo: type t += T [@@foo]] + [%%foo: exception X [@@foo]] + [%%foo: module [@foo] M : S] + + [%%foo: + module [@foo] rec M : S + and [@foo] M : S] + + [%%foo: module [@foo] M = M] + [%%foo: module type S = S [@@foo]] + [%%foo: include M [@@foo]] + [%%foo: open M [@@foo]] + [%%foo: class x : t [@@foo]] + [%%foo: class type x = x [@@foo]] +end diff --git a/test/passing/refs.janestreet/sig_value.mli.err b/test/passing/refs.janestreet/sig_value.mli.err new file mode 100644 index 0000000000..3ffe29e390 --- /dev/null +++ b/test/passing/refs.janestreet/sig_value.mli.err @@ -0,0 +1,2 @@ +Warning: sig_value.mli:4 exceeds the margin +Warning: sig_value.mli:13 exceeds the margin diff --git a/test/passing/refs.janestreet/sig_value.mli.ref b/test/passing/refs.janestreet/sig_value.mli.ref new file mode 100644 index 0000000000..44b7d716b1 --- /dev/null +++ b/test/passing/refs.janestreet/sig_value.mli.ref @@ -0,0 +1,19 @@ +val f : f:(string[@att]) (** doc *) -> unit + +val f + : f:(string[@att]) + (** doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc *) + -> unit + +val f : f:(string[@att]) -> unit +val f : f:string (** doc *) -> unit +val f : f:(string * string[@att]) (** doc *) -> unit + +val f + : f:(string * string[@att]) + (** doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc *) + -> unit + +val f : f:(string * string[@att]) -> unit +val f : f:string * string (** doc *) -> unit +val f : t/1 -> f:(unit -> unit t/2) -> unit M/2.t diff --git a/test/passing/refs.janestreet/single_line.mli.ref b/test/passing/refs.janestreet/single_line.mli.ref new file mode 100644 index 0000000000..9e7e313eab --- /dev/null +++ b/test/passing/refs.janestreet/single_line.mli.ref @@ -0,0 +1,6 @@ +[@@@ocamlformat "module-item-spacing=compact"] + +val xx_xxxxxxxx : t -> bool +val xx_xxxxxxxx : t -> bool +val xxxxxxxx : t -> [> `Xxxxxxx | `Xxxxxxxxxxx | `Xxxxxxxxxx | `Xxxxxxxxxxxxx ] +val xxxxx : t -> t -> t Xxx.t option diff --git a/test/passing/refs.janestreet/skip.ml.ref b/test/passing/refs.janestreet/skip.ml.ref new file mode 100644 index 0000000000..ededfd8ac7 --- /dev/null +++ b/test/passing/refs.janestreet/skip.ml.ref @@ -0,0 +1,127 @@ +[@@@ocamlformat "disable"] + +let this_won't_be_formatted = + 1 +[@@@ocamlformat "enable"] + +let x = function + | A , B -> 1 + | BBB , _ -> 2 + | CCCcccc , CCCCCCCC -> 3 +[@@ocamlformat "disable"] + +let x = function + | A, B -> 1 + | BBB, _ -> 2 + | CCCcccc, CCCCCCCC -> 3 +;; + +module S = struct + let x = function + | A , B -> 1 + | BBB , _ -> 2 + | CCCcccc , CCCCCCCC -> (* cmt about 3 *) 3 + [@@ocamlformat "disable"] +end + +module S = struct + let x = function + | A, B -> 1 + | BBB, _ -> 2 + | CCCcccc, CCCCCCCC -> (* cmt about 3 *) 3 + ;; + + let x = function + | A, B -> 1 + | BBB, _ -> 2 + | CCCcccc, CCCCCCCC -> (* cmt about 3 *) 3 + ;; + + [@@@ocamlformat "disable"] + + let x = function + | A , B -> 1 + | BBB , _ -> 2 + | CCCcccc , CCCCCCCC -> (* cmt about 3 *) 3 + + [@@@ocamlformat "enable"] + + let x = function + | A, B -> 1 + | BBB, _ -> 2 + | CCCcccc, CCCCCCCC -> (* cmt about 3 *) 3 + ;; + + let _ = + let x = 3 in + match[@ocamlformat "disable"] x,y with + | Some _, None -> test + | None , Some _ -> test + | Some _, Some _ -> test + | None , None -> test + ;; +end + +let x = function + | A, B -> 1 + | BBB, _ -> 2 + | CCCcccc, CCCCCCCC -> (* cmt about 3 *) 3 +;; + +module type S = sig + type t = int * int + [@@ocamlformat "disable"] + + [@@@ocamlformat "disable"] + + val x : a : t -> b: t + -> c : t -> unit +end + +let x = fun fc -> + let x = 3 in + match x,y with + | Some _, None -> test + | None , Some _ -> test + | Some _, Some _ -> test + | None , None -> test + [@@ocamlformat "disable"] + +let x = + fun[@ocamlformat "disable"] fc -> + let x = 3 in + match x,y with + | Some _, None -> test + | None , Some _ -> test + | Some _, Some _ -> test + | None , None -> test +;; + +let _ = (x [@ocamlformat "disable"] [@test? _ when e [@test 2]]) 3 + +let _ = + let module X = struct + let x = 4 + end + in + X.x +;; + +let _ = + let module X = + struct + let x = 4 + end [@ocamlformat "disable"] in + X.x +;; + +let _ = + let module X = struct + module S = + struct + let x = 4 + end [@ocamlformat "disable"] + end + in + X.x +;; diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/refs.janestreet/source.ml.ref similarity index 89% rename from test/passing/tests/js_source.ml.ref rename to test/passing/refs.janestreet/source.ml.ref index 3b8f3ab7ad..25f1b6dd71 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/refs.janestreet/source.ml.ref @@ -227,10 +227,6 @@ module type S = sig class%foo [@foo] x : t class type%foo [@foo] x = x - - class%foo x : t [@@foo] - - class type%foo x = x [@@foo] end type t = .. @@ -9501,6 +9497,7 @@ function ;; fun contents -> { contents = contents [@foo] };; +fun contents -> { contents = contents [@foo]; foo };; (); ((); @@ -9556,240 +9553,39 @@ module Indexop = struct let x, y, z = Def.(h.%["one"], h.%("two"), h.%{"three"}) end -type t = | - -include struct - let%test_module "as" = - (module struct - let%expect_test "xx xx xxxxxx xxxxxxx xxxxxx xxxxxx xxxxxxxx xx xxxxx xxx xx xxxxx" = - () - ;; - end) - ;; -end -;; - -if fffffffffffffff aaaaa bb -then (if b then aaaaaaaaaaaaaaaa ffff) -else aaaaaaaaaaaa qqqqqqqqqqq +type t = |;; -include Base.Fn (** @open *) +M.(Some x) [@foo] -let ssmap - : (module MapT with type key = string and type data = string and type map = SSMap.map) - = - () -;; - -let ssmap - : (module MapT with type key = string and type data = string and type map = SSMap.map) - -> unit - = - () -;; - -let _ = - match x with - | A -> - [%expr - match y with - | e -> e] -;; +[@@@foo:] -let _ = - match x with - | A -> - [%expr - match y with - | e -> - (match e with - | x -> x)] -;; +let x = (A B).a +let x = A (B).a -let _ = - List.map rows ~f:(fun row -> - Or_error.try_with (fun () -> fffffffffffffffffffffffff row)) +let formula_base x = + let open Formula.Infix in + (Expr.typeof x)#==(Lit (Type IntType))#&&(x#<=(Expr.int 4))#&&((Expr.int 0)#<x) ;; -module type T = sig - (** @raise if not found. *) - val find : t -> key -> value option - - (** @param blablabla *) - val f : a_few:params -> with_long_names:to_break -> the_line:before_the_comment -> unit -end - -open! Core - -(** First documentation comment. *) -exception First_exception - -(** Second documentation comment. *) -exception Second_exception - -module M = struct - type t - [@@immediate] - (* ______________________________________ *) - [@@deriving variants, sexp_of] -end - -module type Basic3 = sig - type ('a, 'd, 'e) t - - val return : 'a -> ('a, _, _) t - val apply : ('a -> 'b, 'd, 'e) t -> ('a, 'd, 'e) t -> ('b, 'd, 'e) t - - val map - : [ `Define_using_apply - | `Custom of ('a, 'd, 'e) t -> f:('a -> 'b) -> ('b, 'd, 'e) t - ] -end - -let _ = - aa - (bbbbbbbbb - cccccccccccc - dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd) -;; - -let _ = - "_______________________________________________________ \ - _______________________________" -;; - -let _ = - [ very_long_function_name____________________ very_long_argument_name____________ ] -;; - -(* FIX: exceed 90 columns *) -let _ = - [%str - let () = very_long_function_name__________________ very_long_argument_name____________] -;; - -let _ = - { long_field_name = 9999999999999999999999999999999999999999999999999999999999999999999 - } -;; - -(* FIX: exceed 90 columns *) -let _ = - match () with - | _ -> - (match () with - | _ -> - long_function_name long_argument_name__________________________________________) -;; - -let _ = - aaaaaaa - (* __________________________________________________________________________________ *) - := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb -;; - -let g = - f - ~x - (* this is a multiple-line-spanning - comment *) - ~y -;; - -let f = - very_long_function_name - ~x:very_long_variable_name - (* this is a multiple-line-spanning - comment *) - ~y -;; - -let _ = - match x with - | { y = - (* _____________________________________________________________________ *) - ( X _ | Y _ ) - } -> () -;; - -let _ = - match x with - | { y = - ( Z - (* _____________________________________________________________________ *) - | X _ - | Y _ ) - } -> () -;; +let _ = call ~f:(fun pair -> (pair : a * b));; -type t = - [ `XXXX - (* __________________________________________________________________________________ *) - | `XXXX (* __________________________________________________________________ *) - | `XXXX (* _____________________________________________________ *) - | `XXXX (* ___________________________________________________ *) - | `XXXX (* ___________________________________________________ *) - | `XXXX (* ________________________________________________ *) - | `XXXX (* __________________________________________ *) - | `XXXX (* _________________________________________ *) - | `XXXX (* ______________________________________ *) - | `XXXX (* ____________________________________ *) - ] - -type t = - { field : ty - (* Here is some verbatim formatted text: - {v - starting at column 7 - v}*) - } - -module Intro_sort = struct - let foo_fooo_foooo fooo ~foooo m1 m2 m3 m4 m5 = - (* Fooooooooooooooooooooooooooo: - {v - 1--o-----o-----o--------------1 - | | | - 2--o-----|--o--|-----o--o-----2 - | | | | | - 3--------o--o--|--o--|--o-----3 - | | | - 4-----o--------o--o--|-----o--4 - | | | - 5-----o--------------o-----o--5 - v} *) - foooooooooo fooooo fooo; - foooooooooo fooooo fooo; - foooooooooo fooooo fooo - ;; -end - -let _ = - "_ _____________________ ___________ ________ _____________ ________ _____________ \ - _____\n\n\ - \ ___________________" -;; - -let nullsafe_optimistic_third_party_params_in_non_strict = - CLOpt.mk_bool - ~long:"nullsafe-optimistic-third-party-params-in-non-strict" - (* Turned on for compatibility reasons. Historically this is because - there was no actionable way to change third party annotations. Now - that we have such a support, this behavior should be reconsidered, - provided our tooling and error reporting is friendly enough to be - smoothly used by developers. *) - ~default:true - "Nullsafe: in this mode we treat non annotated third party method params as if they \ - were annotated as nullable." +f + (fun _ -> function + | true -> + let () = () in + () + | false -> ()) + () ;; -let foo () = - if%bind - (* this is a medium length comment of some sort *) - this is a medium length expression of_some sort - then x - else y -;; +f + (fun _ -> function + | true -> + let () = () in + () + (* comment *) + | false -> ()) + () let xxxxxx = let%map (* _____________________________ @@ -9797,580 +9593,29 @@ let xxxxxx = { zzzzzzzzzzzzz } ;; -let _ = - match x with - | _ - when f - ~f: - (function [@ocaml.warning (* ....................................... *) "-4"] - | _ -> .) -> y -;; - -let[@a - (* .............................................. ........................... .......................... ...................... *) - foo - (* ....................... *) - (* ................................. *) - (* ...................... *)] _ - = - match[@ocaml.warning (* ....................................... *) "-4"] - x [@attr (* .......................... .................. *) some_attr] - with - | _ - when f - ~f:(function[@ocaml.warning (* ....................................... *) "-4"] - | _ -> .) - ~f: - (function[@ocaml.warning - (* ....................................... *) - (* ....................................... *) - "foooooooooooooooooooooooooooo \ - fooooooooooooooooooooooooooooooooooooo"] - | _ -> .) - ~f: - (function[@ocaml.warning - (* ....................................... *) - let x = a - and y = b in - x + y] _ -> .) -> - y - [@attr - (* ... *) - (* ... *) - attr (* ... *)] -;; - -let x = - foo (`A b) ~f:(fun thing -> - something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping) -;; - -let x = - foo (`A `b) ~f:(fun thing -> - something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping) -;; - -let x = - foo [ A; B ] ~f:(fun thing -> - something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping) -;; - -let x = - foo [ [ A ]; B ] ~f:(fun thing -> - something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping) -;; - -let x = - f - ("A string _____________________" - ^ "Another string _____________" - ^ "Yet another string _________") -;; - -let x = - some_fun________________________________ - some_arg______________________________ - (fun param -> - do_something (); - do_something_else (); - return_this_value) -;; - -let x = - some_fun________________________________ - some_arg______________________________ - ~f:(fun param -> - do_something (); - do_something_else (); - return_this_value) -;; - -let x = - some_value - |> some_fun (fun x -> - do_something (); - do_something_else (); - return_this_value) -;; - -let x = - some_value - ^ some_fun (fun x -> - do_something (); - do_something_else (); - return_this_value) -;; - -let bind t ~f = - unfold_step - ~f:(function - | Sequence { state = seed; next }, rest -> - (match next seed with - | Done -> - (match rest with - | Sequence { state = seed; next } -> - (match next seed with - | Done -> Done - | Skip { state = s } -> - Skip { state = empty, Sequence { state = s; next } } - | Yield { value = a; state = s } -> - Skip { state = f a, Sequence { state = s; next } })) - | Skip { state = s } -> Skip { state = Sequence { state = s; next }, rest } - | Yield { value = a; state = s } -> - Yield { value = a; state = Sequence { state = s; next }, rest })) - ~init:(empty, t) -;; - -let () = - very_long_function_name - ~very_long_argument_label: - (fun - very_long_argument_name_one - very_long_argument_name_two - very_long_argument_name_three - -> ()) -;; - -let () = - ((one_mississippi, two_mississippi, three_mississippi, four_mississippi) - : Mississippi.t * Mississippi.t * Mississippi.t * Mississippi.t) -;; - -let _ = - ((match foo with - | Bar -> bar - | Baz -> baz) - : string) -;; - -let _ = - ((match foo with - | Bar -> bar - | Baz -> baz) - :> string) -;; - -let _ = - aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa - ~bbbbbbbbbbbbbbbbbbbbbbbbbbbb: - (fun - (_ : (ccccccccccccc * ddddddddddddddddddddddddddddd) eeee) -> FFFFFFFFF gg) - ~h -;; - -type t -[@@deriving - some_deriver_name -, another_deriver_name -, another_deriver_name -, another_deriver_name -, yet_another_such_name -, such_that_they_line_wrap] - -type t -[@@deriving - some_deriver_name - another_deriver_name - another_deriver_name - another_deriver_name - yet_another_such_name - such_that_they_line_wrap] - -let pat = - String.Search_pattern.create - (String.init len ~f:(function - | 0 -> '\n' - | n when n < len - 1 -> ' ' - | _ -> '*')) -;; - -type t = - { break_separators : [ `Before | `After ] - ; break_sequences : bool - ; break_string_literals : [ `Auto | `Never ] - (** How to potentially break string literals into new lines. *) - ; break_struct : bool - ; cases_exp_indent : int - ; cases_matching_exp_indent : [ `Normal | `Compact ] - } - -let rec collect_files - ~enable_outside_detected_project - ~root - ~segs - ~ignores - ~enables - ~files - = - match segs with - | [] | [ "" ] -> ignores, enables, files, None -;; - -let _ = - fooooooooooooooooooooooooooooooooooooooo - fooooooooooooooooooooooooooooooooooooooo - fooooooooooooooooooooooooooooooooooooooo - ~f:(fun (type a) foooooooooooooooooooooooooooooooooo : 'a -> - match fooooooooooooooooooooooooooooooooooooooo with - | Fooooooooooooooooooooooooooooooooooooooo -> x - | Fooooooooooooooooooooooooooooooooooooooo -> x) -;; - -let _ = - foo - |> List.map ~f:(fun x -> - do_something (); - do_something (); - do_something (); - do_something (); - do_something_else ()) -;; - -let _ = - foo - |> List.map ~f:(fun x -> - do_something (); - do_something (); - do_something (); - do_something (); - do_something_else ()) - |> bar -;; - -let _ = - foo - |> List.map - fooooooooooo - fooooooooooo - fooooooooooo - fooooooooooo - fooooooooooo - fooooooooooo - fooooooooooo - fooooooooooo -;; - -let _ = foo |> List.map (function A -> do_something ()) - -let _ = - foo - |> List.map (function - | A -> do_something () - | A -> do_something () - | A -> do_something () - | A -> do_something () - | A -> do_something_else ()) - |> bar -;; - -let _ = - foo - |> List.double_map - ~f1:(fun x -> - do_something (); - do_something (); - do_something (); - do_something (); - do_something_else ()) - ~f2:(fun x -> - do_something (); - do_something (); - do_something (); - do_something (); - do_something_else ()) - |> bar -;; - -module Stritem_attributes_indent : sig - val f : int -> int -> int -> int -> int - [@@cold] [@@inline never] [@@local never] [@@specialise never] - - external unsafe_memset - : t - -> pos:int - -> len:int - -> char - -> unit - = "bigstring_memset_stub" - [@@noalloc] -end = struct - let raise_length_mismatch name n1 n2 = - invalid_argf "length mismatch in %s: %d <> %d" name n1 n2 () - [@@cold] [@@inline never] [@@local never] [@@specialise never] - ;; - - external unsafe_memset - : t - -> pos:int - -> len:int - -> char - -> unit - = "bigstring_memset_stub" - [@@noalloc] -end - -let _ = - foo - $$ (match group with - | [] -> impossible "previous match" - | [ cmt ] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt) - $$ bar -;; - -let _ = - foo - $$ (try group with - | [] -> impossible "previous match" - | [ cmt ] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt) - $$ bar -;; - -let _ = - x == exp - || - match x with - | { pexp_desc = Pexp_constraint (e, _); _ } -> loop e - | _ -> false -;; - -let _ = - let module M = struct - include - (val foooooooooooooooooooooooooooooooooooooooo - : fooooooooooooooooooooooooooooooooooooooooo) - end - in - () -;; - -type action = - | In_out of [ `Impl | `Intf ] input * string option - (** Format input file (or [-] for stdin) of given kind to output file, - or stdout if None. *) - (* foo *) - | Inplace of [ `Impl | `Intf ] input list - (** Format in-place, overwriting input file(s). *) - -let%test_module "semantics" = - (module ( - struct - open Core - open Appendable_list - module Stable = Stable - end : - S)) -;; - -let _ = - Error - (`Foooooooooooooooooo - (name, Format.sprintf "expecting %S but got %S" Version.version value)) -;; - -let _ = - `Foooooooooooooooooo - (name, Format.sprintf "expecting %S but got %S" Version.version value) -;; - -let _ = - Foooooooooooooooooo - (name, Format.sprintf "expecting %S but got %S" Version.version value) -;; - -let (`Foooooooooooooooooo - (foooooooooooooo, foooooooooooooo, foooooooooooooo, foooooooooooooo)) - = - x -;; +let _ = fun (x : int as 'a) -> (x : int as 'a) -let (Foooooooooooooooooo - (foooooooooooooo, foooooooooooooo, foooooooooooooo, foooooooooooooo)) - = - x +let eradicate_meta_class_is_nullsafe = + register + ~id:"ERADICATE_META_CLASS_IS_NULLSAFE" + ~hum:"Class is marked @Nullsafe and has 0 issues" + (* Should be enabled for special integrations *) + ~enabled:false + Info + Eradicate (* TODO *) + ~user_documentation:"" ;; -let _ = - Foooooooooooooooooooo.foooooooooooooooooooo - foooooooooooooooooooo - foooooooooooooooooooo - (fun x -> function - | Foooooooooooooooooooo -> foooooooooooooooooooo - | Foooooooooooooooooooo -> foooooooooooooooooooo) -;; - -let _ = - Foooooooooooooooooooo.foooooooooooooooooooo - foooooooooooooooooooo - foooooooooooooooooooo - ~x:(fun x -> function - | Foooooooooooooooooooo -> foooooooooooooooooooo - | Foooooooooooooooooooo -> foooooooooooooooooooo) +let eradicate_meta_class_is_nullsafe = + register + ~id:"ERADICATE_META_CLASS_IS_NULLSAFE" + (* Should be enabled for special integrations *) + ~hum:"Class is marked @Nullsafe and has 0 issues" + (* Should be enabled for special integrations *) + ~enabled:false + Info ;; -let _ = - Foooooooooooooooooooo.foooooooooooooooooooo - foooooooooooooooooooo - foooooooooooooooooooo - (fun x -> - match foo with - | Foooooooooooooooooooo -> foooooooooooooooooooo - | Foooooooooooooooooooo -> foooooooooooooooooooo) -;; - -let _ = - Foooooooooooooooooooo.foooooooooooooooooooo - foooooooooooooooooooo - foooooooooooooooooooo - ~x:(fun x -> - match foo with - | Foooooooooooooooooooo -> foooooooooooooooooooo - | Foooooooooooooooooooo -> foooooooooooooooooooo) -;; - -let _ = - let x = x in - fun foooooooooooooooooo - foooooooooooooooooo - foooooooooooooooooo - foooooooooooooooooo - foooooooooooooooooo - foooooooooooooooooo -> () -;; - -module type For_let_syntax_local = - For_let_syntax_gen - with type ('a, 'b) fn := ('a[@local]) -> 'b - and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b - -type fooooooooooooooooooooooooooooooo = - ( fooooooooooooooooooooooooooooooo - , fooooooooooooooooooooooooooooooo ) - fooooooooooooooooooooooooooooooo - -val fooooooooooooooooooooooooooooooo - : ( fooooooooooooooooooooooooooooooo - , fooooooooooooooooooooooooooooooo ) - fooooooooooooooooooooooooooooooo - -(* *) - -(** - xxx -*) -include S1 -(** @inline *) - -type input = - { name : string - ; action : [ `Format | `Numeric of range ] - } - -let x = - fun [@foo] x -> - fun [@foo] y -> - object - method x = y - end -;; - -class x = - fun [@foo] x -> - fun [@foo] y -> - object - method x = y - end - -module M = - [%demo - module Foo = Bar - - type t] - -let _ = - Some - (fun fooooooooooooooooooooooooooooooo - fooooooooooooooooooooooooooooooo - fooooooooooooooooooooooooooooooo -> foo) -;; - -type t = - { xxxxxx : - t - (* _________________________________________________________________________ - ____________________________________________________________________ - ___________ *) - XXXXXXX.t - } - -module Test_gen - (For_tests : For_tests_gen) - (Tested : - S_gen with type 'a src := 'a For_tests.Src.t with type 'a dst := 'a For_tests.Dst.t) - (Tested : - S_gen - with type 'a src := 'a For_tests.Src.t - with type 'a dst := 'a For_tests.Dst.t - and type 'a dst := 'a For_tests.Dst.t - and type 'a dst := 'a For_tests.Dst.t) = -struct - open Tested - open For_tests -end - -type t = - { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : - YYYYYYYYYYYYYYYYYYYYY.t - (* ____________________________________ *) - } - -(*{v - - foo - -v}*) - -(*$ - {| - f|} -*) - -type t = - { xxxxxxxxxxxxxxxxxxx : yyy - [@zzzzzzzzzzzzzzzzzzz - (* ________________________________ - ___ *) - _______] - } - -let _ = - match () with - (*$ Printf.(printf "\n | _ -> .\n;;\n") *) - | _ -> . -;; - -(*$*) - -(*$ "________________________" $*) - -(*$ - let open! Core in - () -*) -(*$*) - -(*$ - [%string - {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx -zzzzzzzzzzzzzzzzzzzzzzzzzzzz - |}] -*) -(*$*) - -(*$ - {| - f|} -*) - let () = match () with | _ -> @@ -10380,169 +9625,12 @@ let () = | _ -> () ;; -(* ocp-indent-compat: Docked fun after apply only if on the same line. *) - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo:(fun foo -> bar) -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo:(fun foo -> bar) - ~fooooooooooooooooooooooooooooooo -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo:(fun foo -> - match bar with - | Some _ -> foo - | None -> baz) -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo (fun foo -> bar) -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo (fun foo -> - match bar with - | Some _ -> foo - | None -> baz) -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo - (fun foo -> - match bar with - | Some _ -> foo - | None -> baz) -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooofooooooooooooooooooooooooooooooofoooooooooo - (fun foo -> - match bar with - | Some _ -> foo - | None -> baz) -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> foooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo (function foo -> bar) -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo (function - | Some _ -> foo - | None -> baz) -;; - -(* *) - -(*$ (* *) *) - -(** xxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx - xxxx] xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx] *) - -(* Hand-aligned comment - . - . *) - -(* First line is indented more - . - . *) - -module type M = sig - val imported_sets_of_closures_table - : Simple_value_approx.function_declarations option - Set_of_closures_id.Tbl.fooooooooooooooooooooooooo -end - -(*$ let _ = [ x (* *); y ] *) - -let _ = - { foo = - (fun _ -> function - | _ -> - let _ = 42 in - () - | () -> ()) - } -;; - -let _ = - match () with - | _ -> - f - >>= (function - | `Fooooooooooooooooooooooooooooooooooooooo -> 1 - | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> 2) -;; - -let _ = - match () with - | _ -> - f - >>= (function - | `Fooooooooooooooooooooooooooooooooooooooo -> 1 - | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> 2) - >>= foo -;; - -let exists t key = - S.Tree.kind t.tree (path key) - >|= function - | Some `Contents -> Ok (Some `Value) - | Some `Node -> Ok (Some `Dictionary) - | None -> Ok None -;; - -let _ = if x then 42 (* dummy *) else y -let _ = if x then 42 (* dummy *) else if y then z else w - -let _ = - if x - then - fun _ -> true - (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) - else f +let f = function + | Foo -> bar + | EArr l -> + EArr + (List.map l ~f:(function + | ElementHole -> ElementHole + | Element e -> Element (m#expression e) + | ElementSpread e -> ElementSpread (m#expression e))) ;; - -let _ = - match ids_queue with - | Some q -> - (* this is more efficient than a linear scan of [ids] *) - fun id -> not (Ident.HashQueue.mem q id) - | None -> fun id -> not (List.mem ~equal:Ident.equal ids id) -;; - -type callbacks = - { html_debug_new_node_session_f : - 'a. - ?kind:[ `ComputePre | `ExecNode | `ExecNodeNarrowing | `WTO ] - -> pp_name:(Format.formatter -> unit) - -> Procdesc.Node.t - -> f:(unit -> 'a) - -> 'a - } diff --git a/test/passing/refs.janestreet/str_value.ml.ref b/test/passing/refs.janestreet/str_value.ml.ref new file mode 100644 index 0000000000..ed99ea2659 --- /dev/null +++ b/test/passing/refs.janestreet/str_value.ml.ref @@ -0,0 +1,129 @@ +module Compact = struct + [@@@ocamlformat "let-binding-spacing=compact"] + + (* doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + (** doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = + dddd + dddddddddd + dddddddddd + dddddddddddd + ddddddddd + dddddddddd + dddddddddddddddddddd + dddddddddddd + + and f x = + dddd + dddddddddd + dddddddddd + dddddddddddd + ddddddddd + dddddddddd + dddddddddddddddddddd + dddddddddddd + + let f x = + dddd + dddddddddd + dddddddddd + dddddddddddd + ddddddddd + dddddddddd + dddddddddddddddddddd + dddddddddddd +end + +module Nl = struct + [@@@ocamlformat "let-binding-spacing=sparse"] + + (* doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + (** doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = + dddd + dddddddddd + dddddddddd + dddddddddddd + ddddddddd + dddddddddd + dddddddddddddddddddd + dddddddddddd + + + and f x = + dddd + dddddddddd + dddddddddd + dddddddddddd + ddddddddd + dddddddddd + dddddddddddddddddddd + dddddddddddd + + + let f x = + dddd + dddddddddd + dddddddddd + dddddddddddd + ddddddddd + dddddddddd + dddddddddddddddddddd + dddddddddddd +end + +module Double = struct + [@@@ocamlformat "let-binding-spacing=double-semicolon"] + + (* doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + (** doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = + dddd + dddddddddd + dddddddddd + dddddddddddd + ddddddddd + dddddddddd + dddddddddddddddddddd + dddddddddddd + + and f x = + dddd + dddddddddd + dddddddddd + dddddddddddd + ddddddddd + dddddddddd + dddddddddddddddddddd + dddddddddddd + ;; + + let f x = + dddd + dddddddddd + dddddddddd + dddddddddddd + ddddddddd + dddddddddd + dddddddddddddddddddd + dddddddddddd + ;; +end diff --git a/test/passing/refs.janestreet/string.ml.ref b/test/passing/refs.janestreet/string.ml.ref new file mode 100644 index 0000000000..714aac48da --- /dev/null +++ b/test/passing/refs.janestreet/string.ml.ref @@ -0,0 +1,47 @@ +let f = function + | () -> + raise_s + [%sexp + "Xxxx \036 \036 \036 \036 \036 \036 \036 xxx xxxx xx xxxxxx xx xxx xxxxxxx \ + xxxxxx, xxxxxxx xxxxxxxxxx xx xxxx. Xxxx." + , 0] +;; + +let _ = "\010\xFFa\o123\n\\\u{12345}aa🐪🐪🐪🐪🐪\n" + +let _ = + "aaaaaaaaaaaaaaaaaaaaaaaaa\n\tbbbbbbbbbbbbbbbbbbbbbbbbbb\n\tcccccccccccccccccc\n\t" +;; + +let _ = "aaaaaaaaaaaaaaaaaaaaaaaaa\n bbbbbbbbbbbbbbbbbbbbbbbbbb\n cccccccccccccccccc\n " +let _ = '\xff', '\255', '\n' + +let f = function + | '\xff' .. '\255' -> () +;; + +let f ("test" [@test "test"]) = 2;; + +"@\n\ +\ xxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxx xxxxxxxx \ + xxxxxxxxxxx" + +external%c print + : str:string + -> d:int + -> void + = {| + printf("%s (%d)\n",$str,$d); + fflush(stdout); +|} + {| + printf("%s (%d)\n",$str,$d); + fflush(stdout); +|} + +external x : t = (* a *) "x" (* b *) "y" (* c *) + +external x + : t + = (* aaaaaaa aaaaaa aaaaaa *) {|xxxxxx xxxxx xxxx|} + (* bbbbbb bbbbb bbbbbb *) {|yyyy yyyy yyyyy|} (* cccccc ccccc cccccc *) diff --git a/test/passing/refs.janestreet/string_array.ml.ref b/test/passing/refs.janestreet/string_array.ml.ref new file mode 100644 index 0000000000..66f871df37 --- /dev/null +++ b/test/passing/refs.janestreet/string_array.ml.ref @@ -0,0 +1,14 @@ +(f ()).(2) <- e;; +(f ()).(2) <- e, 2;; +((f ()).(2) <- e), 2;; +(f ()).[2] <- e;; +(f ()).[2] <- e, 2;; +((f ()).[2] <- e), 2;; +(f ()).{2} <- e;; +(f ()).{2} <- e, 2;; +((f ()).{2} <- e), 2;; +(f ()).{2, 2, 2, 2} <- e;; +(f ()).{2, 2, 2, 2} <- e, 2;; +((f ()).{2, 2, 2, 2} <- e), 2 + +let l = [| (fun x -> x); (fun y -> y) |] diff --git a/test/passing/refs.janestreet/string_wrapping.ml.ref b/test/passing/refs.janestreet/string_wrapping.ml.ref new file mode 100644 index 0000000000..a9c14887d7 --- /dev/null +++ b/test/passing/refs.janestreet/string_wrapping.ml.ref @@ -0,0 +1,4 @@ +let universal_declaration = + "-1- Programs are born and remain free and equal under the law;\n\ + distinctions can only be based on the common good." +;; diff --git a/test/passing/refs.janestreet/symbol.ml.ref b/test/passing/refs.janestreet/symbol.ml.ref new file mode 100644 index 0000000000..39514ccd3d --- /dev/null +++ b/test/passing/refs.janestreet/symbol.ml.ref @@ -0,0 +1,26 @@ +let op = if b then ( * ) else ( + ) in +() +;; + +assert ( * );; +( * ) [@a];; +assert (( * ) [@a]) + +module Array = struct + let ( .!() ) = Array.unsafe_get + let ( .!()<- ) = Array.unsafe_set +end + +let ( .!() ), ( .!()<- ) = Array.((( .!() ) [@attr]), ( .!()<- )) +let _ = ( let++ ) [@attr];; + +( let++ ) [@attr] + +let ( let++ ), (( and++ ) [@attr]) = X.((( let++ ) [@attr]), ( and++ )) + +let is_empty = function + | [] -> true + | ( :: ) _ -> false +;; + +let is_empty = ( :: ), ( :: ) 1, (Foo) 2 diff --git a/test/passing/refs.janestreet/tag_only.ml.ref b/test/passing/refs.janestreet/tag_only.ml.ref new file mode 100644 index 0000000000..dc5870b870 --- /dev/null +++ b/test/passing/refs.janestreet/tag_only.ml.ref @@ -0,0 +1,181 @@ +open Module (** @deprecated *) + +(** abc + + @deprecated *) +open Module + +open Module (** @author A *) + +open Module (** @inline *) + +include Abc (** @inline *) + +(** @inline *) +include struct + type t +end + +include (Module : Type) (** @inline *) + +module A = B (** @inline *) + +(** @inline *) +module A : sig + type t +end = struct + type t +end + +(** @inline *) +module rec A : sig + type t +end = struct + type t +end + +(** @author B *) +and B : sig + type t +end = struct + type t +end + +module type A = B (** @deprecated abc *) + +(** @deprecated abc *) +module type A = sig + type t +end + +(** @open *) +module A : sig + type t +end = + B + +open Module.With_veryyyyyy_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame +(** @deprecated *) + +include Module.With_very_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame +(** @deprecated *) + +module A = Module.With_very_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame +(** @deprecated *) + +(** @deprecated *) +type t = T + +type t = t (** @deprecated *) + +(** @deprecated *) +let a = b + +(** @deprecated *) +type t = t +(** @deprecated *) + +class b = + object + method f = 0 (** @deprecated *) + + inherit a (** @deprecated *) + + val x = 1 (** @deprecated *) + + constraint 'a = [> ] (** @deprecated *) + + initializer do_init () (** @deprecated *) + end + +[@@@ocamlformat "doc-comments-tag-only=fit"] + +open Module (** @deprecated *) + +(** abc + + @deprecated *) +open Module + +open Module (** @author A *) + +open Module (** @inline *) + +include Abc (** @inline *) + +(** @inline *) +include struct + type t +end + +include (Module : Type) (** @inline *) + +module A = B (** @inline *) + +(** @inline *) +module A : sig + type t +end = struct + type t +end + +(** @inline *) +module rec A : sig + type t +end = struct + type t +end + +(** @author B *) +and B : sig + type t +end = struct + type t +end + +module type A = B (** @deprecated abc *) + +(** @deprecated abc *) +module type A = sig + type t +end + +(** @open *) +module A : sig + type t +end = + B + +open Module.With_veryyyyyy_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame +(** @deprecated *) + +include Module.With_very_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame +(** @deprecated *) + +module A = Module.With_very_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame +(** @deprecated *) + +(** @deprecated *) +type t = T + +type t = t (** @deprecated *) + +(** @deprecated *) +let a = b + +(** @deprecated *) +type t = t +(** @deprecated *) + +class b = + object + method f = 0 (** @deprecated *) + + inherit a (** @deprecated *) + + val x = 1 (** @deprecated *) + + constraint 'a = [> ] (** @deprecated *) + + initializer do_init () (** @deprecated *) + end diff --git a/test/passing/refs.janestreet/tag_only.mli.ref b/test/passing/refs.janestreet/tag_only.mli.ref new file mode 100644 index 0000000000..74209a07b1 --- /dev/null +++ b/test/passing/refs.janestreet/tag_only.mli.ref @@ -0,0 +1,91 @@ +open Module (** @deprecated *) + +(** abc + + @deprecated *) +open Module + +(** @inline *) +include sig + type t +end + +include Type (** @inline *) + +include module type of Module (** @inline *) + +module A : B (** @deprecated *) + +(** @deprecated *) +module A : sig + type t +end + +module type A = B (** @open *) + +(** @open *) +module type A = sig + type t +end + +(** @deprecated *) +type t = T + +(** @deprecated *) +type t = { a : int } + +type t = .. (** @deprecated *) + +type t (** @deprecated *) + +type t = t (** @deprecated *) + +(** @deprecated *) +val a : b + +[@@@ocamlformat "doc-comments-tag-only=fit"] + +open Module (** @deprecated *) + +(** abc + + @deprecated *) +open Module + +(** @inline *) +include sig + type t +end + +include Type (** @inline *) + +include module type of Module (** @inline *) + +module A : B (** @deprecated *) + +(** @deprecated *) +module A : sig + type t +end + +module type A = B (** @open *) + +(** @open *) +module type A = sig + type t +end + +(** @deprecated *) +type t = T + +(** @deprecated *) +type t = { a : int } + +type t = .. (** @deprecated *) + +type t (** @deprecated *) + +type t = t (** @deprecated *) + +(** @deprecated *) +val a : b diff --git a/test/passing/refs.janestreet/try_with_or_pattern.ml.ref b/test/passing/refs.janestreet/try_with_or_pattern.ml.ref new file mode 100644 index 0000000000..bc1ce4bf5e --- /dev/null +++ b/test/passing/refs.janestreet/try_with_or_pattern.ml.ref @@ -0,0 +1,6 @@ +let[@ocamlformat "break-cases=all"] _ = + try () with + | End_of_file + | Not_found -> + () +;; diff --git a/test/passing/refs.janestreet/tuple.ml.ref b/test/passing/refs.janestreet/tuple.ml.ref new file mode 100644 index 0000000000..48c70ae3b1 --- /dev/null +++ b/test/passing/refs.janestreet/tuple.ml.ref @@ -0,0 +1,39 @@ +let _ = + match w with + | A -> ([], A.(B (C (f x))), None, f x y, g y x) + | B -> (a, b, c, d, e, f) + | C -> + ( [] + , A.(B (C (this is very looooooooooooooooooooooooooooooooooooong x))) + , None + , f x y + , g y x ) +;; + +let _ = [%ext 1, 2, 3] + +let _ = + [%ext loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong, 2, 3] +;; + +type t = int [@@deriving 1, 2, 3] + +type t = int +[@@deriving + sexp +, compare +, loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong] + +let _ = + (1, 2, 3, looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong) +;; + +let _ = (1, 2, 3, short);; + +1, 2, 3, looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong;; +1, 2, 3, short + +let (a, b) : int * int = + let (a, b) : int * int = (1, 2) in + (a, b) +;; diff --git a/test/passing/refs.janestreet/tuple_less_parens.ml.ref b/test/passing/refs.janestreet/tuple_less_parens.ml.ref new file mode 100644 index 0000000000..55926b3e67 --- /dev/null +++ b/test/passing/refs.janestreet/tuple_less_parens.ml.ref @@ -0,0 +1,37 @@ +let _ = + match w with + | A -> [], A.(B (C (f x))), None, f x y, g y x + | B -> a, b, c, d, e, f + | C -> + ( [] + , A.(B (C (this is very looooooooooooooooooooooooooooooooooooong x))) + , None + , f x y + , g y x ) +;; + +let _ = [%ext 1, 2, 3] + +let _ = + [%ext loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong, 2, 3] +;; + +type t = int [@@deriving 1, 2, 3] + +type t = int +[@@deriving + sexp +, compare +, loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong] + +let _ = + 1, 2, 3, looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong +;; + +let _ = 1, 2, 3, short;; + +1, 2, 3, looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong;; +1, 2, 3, short + +(* make sure to not drop parens for local open. *) +let _ = A.(1, 2) diff --git a/test/passing/refs.janestreet/tuple_type_parens.ml.ref b/test/passing/refs.janestreet/tuple_type_parens.ml.ref new file mode 100644 index 0000000000..0e488468e3 --- /dev/null +++ b/test/passing/refs.janestreet/tuple_type_parens.ml.ref @@ -0,0 +1,4 @@ +type t = A of a * (b -> unit) + +type u = B of c +and v = d * e diff --git a/test/passing/refs.janestreet/type_and_constraint.ml.ref b/test/passing/refs.janestreet/type_and_constraint.ml.ref new file mode 100644 index 0000000000..abea6fd5cd --- /dev/null +++ b/test/passing/refs.janestreet/type_and_constraint.ml.ref @@ -0,0 +1 @@ +type 'a t = 'a list constraint 'a = [< `X ] diff --git a/test/passing/refs.janestreet/type_annotations.ml.ref b/test/passing/refs.janestreet/type_annotations.ml.ref new file mode 100644 index 0000000000..bf2c99e58f --- /dev/null +++ b/test/passing/refs.janestreet/type_annotations.ml.ref @@ -0,0 +1,17 @@ +let f = + match None with + | (_ : int option) -> true +;; + +let f (x : int) : int = e +let f (x as y : int) : int = e +let f ((x : int) as y) : int = e +let f ((x : int) : int) = e + +let _ = + match x with + | exception (e : exn) -> true + | _ -> false +;; + +let x = (0 : int :> int) diff --git a/test/passing/refs.janestreet/types-compact-space_around-docked.ml.err b/test/passing/refs.janestreet/types-compact-space_around-docked.ml.err new file mode 100644 index 0000000000..69f37030a2 --- /dev/null +++ b/test/passing/refs.janestreet/types-compact-space_around-docked.ml.err @@ -0,0 +1 @@ +Warning: types-compact-space_around-docked.ml:55 exceeds the margin diff --git a/test/passing/refs.janestreet/types-compact-space_around-docked.ml.ref b/test/passing/refs.janestreet/types-compact-space_around-docked.ml.ref new file mode 100644 index 0000000000..7af3a24f03 --- /dev/null +++ b/test/passing/refs.janestreet/types-compact-space_around-docked.ml.ref @@ -0,0 +1,190 @@ +type uu = A of int | B of (< leq : 'a > as 'a) +type uu = A of int | B of (< leq : 'a > as 'a) * 'a +type uu = A of (int as 'a) | B of 'a * (< leq : 'a > as 'a) +type uu += A of (int as 'a) +type uu += B of 'a * (< leq : 'a > as 'a) + +let _ = ignore Async_unix.Fd.(([ stdin (); stdout (); stderr () ] : t list)) + +type t = { x : int } +type t = { a : int; b : int } +type t = [ `A | `B ] + +type loooooooooong_type = { + looooooooooooong_field : looooooooooooong_type; + field2 : type2; +} + +type t = A of (int * int) * int +type t = A of int * int +type t = A of (int * int) + +let _ = + match x with + | Some (Some None) -> t +;; + +type t = .. +type t = private .. +type t = u = private .. +type t += A +type t += B = A +type 'a foo = A of (int -> 'a) +type 'a foo += A of (int -> 'a) +type 'a foo += A : (int -> 'a) -> int foo +type t = [ | a ] +type t = private [< a ] +type t = private [> a ] +type t = [ a | b ] +type t = [ a | b | `C ] +type t = [ `a | b ] +type t = | +type t = [> ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int | `Looooooooooooooooooooong_variant of string ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int (** Doc *) + | `Looooooooooooooooooooong_variant of string (* Comment *) ] + +let (`A | `B) [@bar] = () + +type t = + | Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string | `Unstable of Location.t * string ] + ] + +val x + : [ `X of int + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of + int * foooooooooooooo * fooooooooooo * fooooooooooo foooooooooo * foooooooooooo + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of int (* booooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of + int * foooooooooooooo * fooooooooooo * fooooooooooo foooooooooo * foooooooooooo + (* boooooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +type voting_period = Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + +(** foooooooo *) +type voting_period = + (* foooooooooooo *) + (* foooooooooo ooooooooooooooooo ooooooooooooo *) + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind + (* fooooooooooooooo oooooooooooooooooooo ooooooooooooooooooooo *) + (* fooooo *) = + (* foooooooooo *) + | Proposal + | Testing_vote (** fooooooooooo *) + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher = { + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; +} + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher = + ( 'context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint ) + templ_matcher = { + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; + on_objc_cpp : 'context -> 'f_in; +} + +type ('context, + 'f_in, + 'f_out, + 'captured_types, + 'markers_in, + 'markers_out, + 'list_constraint) + templ_matcher += + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + +module type A = sig + type t := A.t + + type a := A.a + and b := A.b + + type t := A.t = A | B + type t := A | B + + type t := A.t = { a : int; b : int } + and t := { a : int; b : int } + + type t := A.t = .. + type t := .. +end + +type t = [ `A (** A *) | `B [@b] (** B *) | (p[@p]) (* P *) ] + +type foooooooooooooooo = + ?fooooooooo:(string -> unit) -> + ?fooooooooooooo: + (string -> string -> int -> string -> string option foooooooooooooooooooooooo) -> + fooooo:string -> + ?fooooooooo:(unit -> unit Fooo.t) -> + ?fooooooo:bool -> + string option Foooooooo.t + +type ' a' t = ' a' +type ' a' t = ' a' option +type ' a' t = int as ' a' +type t = { a : ' a'. ' a' t' } + +type t = + | Foo + | (* Redirect (None, lib) looks up lib in the same database *) + Redirect of db option * (Loc.t * Lib_name.t) + +type t = + | Foo + | Store of { exp1 : Exp.t; typ : Typ.t option; exp2 : Exp.t; loc : Location.t } + (** *exp1 <- exp2 with exp2:typ *) diff --git a/test/passing/refs.janestreet/types-compact-space_around.ml.err b/test/passing/refs.janestreet/types-compact-space_around.ml.err new file mode 100644 index 0000000000..de2e3d00f6 --- /dev/null +++ b/test/passing/refs.janestreet/types-compact-space_around.ml.err @@ -0,0 +1 @@ +Warning: types-compact-space_around.ml:53 exceeds the margin diff --git a/test/passing/refs.janestreet/types-compact-space_around.ml.ref b/test/passing/refs.janestreet/types-compact-space_around.ml.ref new file mode 100644 index 0000000000..541f7c1321 --- /dev/null +++ b/test/passing/refs.janestreet/types-compact-space_around.ml.ref @@ -0,0 +1,188 @@ +type uu = A of int | B of (< leq : 'a > as 'a) +type uu = A of int | B of (< leq : 'a > as 'a) * 'a +type uu = A of (int as 'a) | B of 'a * (< leq : 'a > as 'a) +type uu += A of (int as 'a) +type uu += B of 'a * (< leq : 'a > as 'a) + +let _ = ignore Async_unix.Fd.(([ stdin (); stdout (); stderr () ] : t list)) + +type t = { x : int } +type t = { a : int; b : int } +type t = [ `A | `B ] + +type loooooooooong_type = + { looooooooooooong_field : looooooooooooong_type; field2 : type2 } + +type t = A of (int * int) * int +type t = A of int * int +type t = A of (int * int) + +let _ = + match x with + | Some (Some None) -> t +;; + +type t = .. +type t = private .. +type t = u = private .. +type t += A +type t += B = A +type 'a foo = A of (int -> 'a) +type 'a foo += A of (int -> 'a) +type 'a foo += A : (int -> 'a) -> int foo +type t = [ | a ] +type t = private [< a ] +type t = private [> a ] +type t = [ a | b ] +type t = [ a | b | `C ] +type t = [ `a | b ] +type t = | +type t = [> ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int | `Looooooooooooooooooooong_variant of string ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int (** Doc *) + | `Looooooooooooooooooooong_variant of string (* Comment *) ] + +let (`A | `B) [@bar] = () + +type t = + | Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string | `Unstable of Location.t * string ] + ] + +val x + : [ `X of int + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of + int * foooooooooooooo * fooooooooooo * fooooooooooo foooooooooo * foooooooooooo + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of int (* booooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of + int * foooooooooooooo * fooooooooooo * fooooooooooo foooooooooo * foooooooooooo + (* boooooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +type voting_period = Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + +(** foooooooo *) +type voting_period = + (* foooooooooooo *) + (* foooooooooo ooooooooooooooooo ooooooooooooo *) + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind + (* fooooooooooooooo oooooooooooooooooooo ooooooooooooooooooooo *) + (* fooooo *) = + (* foooooooooo *) + | Proposal + | Testing_vote (** fooooooooooo *) + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher = + { on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + } + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher = + ( 'context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint ) + templ_matcher = + { on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + } + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher += + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + +module type A = sig + type t := A.t + + type a := A.a + and b := A.b + + type t := A.t = A | B + type t := A | B + + type t := A.t = { a : int; b : int } + and t := { a : int; b : int } + + type t := A.t = .. + type t := .. +end + +type t = [ `A (** A *) | `B [@b] (** B *) | (p[@p]) (* P *) ] + +type foooooooooooooooo = + ?fooooooooo:(string -> unit) + -> ?fooooooooooooo: + (string -> string -> int -> string -> string option foooooooooooooooooooooooo) + -> fooooo:string + -> ?fooooooooo:(unit -> unit Fooo.t) + -> ?fooooooo:bool + -> string option Foooooooo.t + +type ' a' t = ' a' +type ' a' t = ' a' option +type ' a' t = int as ' a' +type t = { a : ' a'. ' a' t' } + +type t = + | Foo + | (* Redirect (None, lib) looks up lib in the same database *) + Redirect of db option * (Loc.t * Lib_name.t) + +type t = + | Foo + | Store of { exp1 : Exp.t; typ : Typ.t option; exp2 : Exp.t; loc : Location.t } + (** *exp1 <- exp2 with exp2:typ *) diff --git a/test/passing/refs.janestreet/types-compact.ml.err b/test/passing/refs.janestreet/types-compact.ml.err new file mode 100644 index 0000000000..b690a40043 --- /dev/null +++ b/test/passing/refs.janestreet/types-compact.ml.err @@ -0,0 +1 @@ +Warning: types-compact.ml:53 exceeds the margin diff --git a/test/passing/refs.janestreet/types-compact.ml.ref b/test/passing/refs.janestreet/types-compact.ml.ref new file mode 100644 index 0000000000..541f7c1321 --- /dev/null +++ b/test/passing/refs.janestreet/types-compact.ml.ref @@ -0,0 +1,188 @@ +type uu = A of int | B of (< leq : 'a > as 'a) +type uu = A of int | B of (< leq : 'a > as 'a) * 'a +type uu = A of (int as 'a) | B of 'a * (< leq : 'a > as 'a) +type uu += A of (int as 'a) +type uu += B of 'a * (< leq : 'a > as 'a) + +let _ = ignore Async_unix.Fd.(([ stdin (); stdout (); stderr () ] : t list)) + +type t = { x : int } +type t = { a : int; b : int } +type t = [ `A | `B ] + +type loooooooooong_type = + { looooooooooooong_field : looooooooooooong_type; field2 : type2 } + +type t = A of (int * int) * int +type t = A of int * int +type t = A of (int * int) + +let _ = + match x with + | Some (Some None) -> t +;; + +type t = .. +type t = private .. +type t = u = private .. +type t += A +type t += B = A +type 'a foo = A of (int -> 'a) +type 'a foo += A of (int -> 'a) +type 'a foo += A : (int -> 'a) -> int foo +type t = [ | a ] +type t = private [< a ] +type t = private [> a ] +type t = [ a | b ] +type t = [ a | b | `C ] +type t = [ `a | b ] +type t = | +type t = [> ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int | `Looooooooooooooooooooong_variant of string ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int (** Doc *) + | `Looooooooooooooooooooong_variant of string (* Comment *) ] + +let (`A | `B) [@bar] = () + +type t = + | Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string | `Unstable of Location.t * string ] + ] + +val x + : [ `X of int + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of + int * foooooooooooooo * fooooooooooo * fooooooooooo foooooooooo * foooooooooooo + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of int (* booooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of + int * foooooooooooooo * fooooooooooo * fooooooooooo foooooooooo * foooooooooooo + (* boooooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +type voting_period = Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + +(** foooooooo *) +type voting_period = + (* foooooooooooo *) + (* foooooooooo ooooooooooooooooo ooooooooooooo *) + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind + (* fooooooooooooooo oooooooooooooooooooo ooooooooooooooooooooo *) + (* fooooo *) = + (* foooooooooo *) + | Proposal + | Testing_vote (** fooooooooooo *) + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher = + { on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + } + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher = + ( 'context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint ) + templ_matcher = + { on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + } + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher += + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + +module type A = sig + type t := A.t + + type a := A.a + and b := A.b + + type t := A.t = A | B + type t := A | B + + type t := A.t = { a : int; b : int } + and t := { a : int; b : int } + + type t := A.t = .. + type t := .. +end + +type t = [ `A (** A *) | `B [@b] (** B *) | (p[@p]) (* P *) ] + +type foooooooooooooooo = + ?fooooooooo:(string -> unit) + -> ?fooooooooooooo: + (string -> string -> int -> string -> string option foooooooooooooooooooooooo) + -> fooooo:string + -> ?fooooooooo:(unit -> unit Fooo.t) + -> ?fooooooo:bool + -> string option Foooooooo.t + +type ' a' t = ' a' +type ' a' t = ' a' option +type ' a' t = int as ' a' +type t = { a : ' a'. ' a' t' } + +type t = + | Foo + | (* Redirect (None, lib) looks up lib in the same database *) + Redirect of db option * (Loc.t * Lib_name.t) + +type t = + | Foo + | Store of { exp1 : Exp.t; typ : Typ.t option; exp2 : Exp.t; loc : Location.t } + (** *exp1 <- exp2 with exp2:typ *) diff --git a/test/passing/refs.janestreet/types-indent.ml.ref b/test/passing/refs.janestreet/types-indent.ml.ref new file mode 100644 index 0000000000..821a7c4095 --- /dev/null +++ b/test/passing/refs.janestreet/types-indent.ml.ref @@ -0,0 +1,246 @@ +type uu = + | A of int + | B of (< leq : 'a > as 'a) + +type uu = + | A of int + | B of (< leq : 'a > as 'a) * 'a + +type uu = + | A of (int as 'a) + | B of 'a * (< leq : 'a > as 'a) + +type uu += A of (int as 'a) +type uu += B of 'a * (< leq : 'a > as 'a) + +let _ = ignore Async_unix.Fd.(([ stdin (); stdout (); stderr () ] : t list)) + +type t = { x : int } + +type t = + { a : int + ; b : int + } + +type t = + [ `A + | `B + ] + +type loooooooooong_type = + { looooooooooooong_field : looooooooooooong_type + ; field2 : type2 + } + +type t = A of (int * int) * int +type t = A of int * int +type t = A of (int * int) + +let _ = + match x with + | Some (Some None) -> t +;; + +type t = .. +type t = private .. +type t = u = private .. +type t += A +type t += B = A +type 'a foo = A of (int -> 'a) +type 'a foo += A of (int -> 'a) +type 'a foo += A : (int -> 'a) -> int foo +type t = [ | a ] +type t = private [< a ] +type t = private [> a ] + +type t = + [ a + | b + ] + +type t = + [ a + | b + | `C + ] + +type t = + [ `a + | b + ] + +type t = | +type t = [> ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int + | `Looooooooooooooooooooong_variant of string + ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int (** Doc *) + | `Looooooooooooooooooooong_variant of string (* Comment *) + ] + +let (`A | `B) [@bar] = () + +type t = + | Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string + | `Unstable of Location.t * string + ] + ] + +val x + : [ `X of int + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of + int * foooooooooooooo * fooooooooooo * fooooooooooo foooooooooo * foooooooooooo + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of int (* booooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of + int * foooooooooooooo * fooooooooooo * fooooooooooo foooooooooo * foooooooooooo + (* boooooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +type voting_period = Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + +(** foooooooo *) +type voting_period = + (* foooooooooooo *) + (* foooooooooo ooooooooooooooooo ooooooooooooo *) + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind + (* fooooooooooooooo oooooooooooooooooooo ooooooooooooooooooooo *) + (* fooooo *) = + (* foooooooooo *) + | Proposal + | Testing_vote (** fooooooooooo *) + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher = + { on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + } + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher = + ( 'context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint ) + templ_matcher = + { on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + } + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher += + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + +module type A = sig + type t := A.t + + type a := A.a + and b := A.b + + type t := A.t = + | A + | B + + type t := + | A + | B + + type t := A.t = + { a : int + ; b : int + } + + and t := + { a : int + ; b : int + } + + type t := A.t = .. + type t := .. +end + +type t = + [ `A (** A *) + | `B [@b] (** B *) + | (p[@p]) (* P *) + ] + +type foooooooooooooooo = + ?fooooooooo:(string -> unit) + -> ?fooooooooooooo: + (string -> string -> int -> string -> string option foooooooooooooooooooooooo) + -> fooooo:string + -> ?fooooooooo:(unit -> unit Fooo.t) + -> ?fooooooo:bool + -> string option Foooooooo.t + +type ' a' t = ' a' +type ' a' t = ' a' option +type ' a' t = int as ' a' +type t = { a : ' a'. ' a' t' } + +type t = + | Foo + | (* Redirect (None, lib) looks up lib in the same database *) + Redirect of db option * (Loc.t * Lib_name.t) + +type t = + | Foo + | Store of + { exp1 : Exp.t + ; typ : Typ.t option + ; exp2 : Exp.t + ; loc : Location.t + } (** *exp1 <- exp2 with exp2:typ *) diff --git a/test/passing/refs.janestreet/types-sparse-space_around.ml.ref b/test/passing/refs.janestreet/types-sparse-space_around.ml.ref new file mode 100644 index 0000000000..a72a631603 --- /dev/null +++ b/test/passing/refs.janestreet/types-sparse-space_around.ml.ref @@ -0,0 +1,246 @@ +type uu = + | A of int + | B of (< leq : 'a > as 'a) + +type uu = + | A of int + | B of (< leq : 'a > as 'a) * 'a + +type uu = + | A of (int as 'a) + | B of 'a * (< leq : 'a > as 'a) + +type uu += A of (int as 'a) +type uu += B of 'a * (< leq : 'a > as 'a) + +let _ = ignore Async_unix.Fd.(([ stdin (); stdout (); stderr () ] : t list)) + +type t = { x : int } + +type t = + { a : int + ; b : int + } + +type t = + [ `A + | `B + ] + +type loooooooooong_type = + { looooooooooooong_field : looooooooooooong_type + ; field2 : type2 + } + +type t = A of (int * int) * int +type t = A of int * int +type t = A of (int * int) + +let _ = + match x with + | Some (Some None) -> t +;; + +type t = .. +type t = private .. +type t = u = private .. +type t += A +type t += B = A +type 'a foo = A of (int -> 'a) +type 'a foo += A of (int -> 'a) +type 'a foo += A : (int -> 'a) -> int foo +type t = [ | a ] +type t = private [< a ] +type t = private [> a ] + +type t = + [ a + | b + ] + +type t = + [ a + | b + | `C + ] + +type t = + [ `a + | b + ] + +type t = | +type t = [> ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int + | `Looooooooooooooooooooong_variant of string + ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int (** Doc *) + | `Looooooooooooooooooooong_variant of string (* Comment *) + ] + +let (`A | `B) [@bar] = () + +type t = + | Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string + | `Unstable of Location.t * string + ] + ] + +val x + : [ `X of int + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of + int * foooooooooooooo * fooooooooooo * fooooooooooo foooooooooo * foooooooooooo + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of int (* booooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of + int * foooooooooooooo * fooooooooooo * fooooooooooo foooooooooo * foooooooooooo + (* boooooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +type voting_period = Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + +(** foooooooo *) +type voting_period = + (* foooooooooooo *) + (* foooooooooo ooooooooooooooooo ooooooooooooo *) + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind + (* fooooooooooooooo oooooooooooooooooooo ooooooooooooooooooooo *) + (* fooooo *) = + (* foooooooooo *) + | Proposal + | Testing_vote (** fooooooooooo *) + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher = + { on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + } + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher = + ( 'context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint ) + templ_matcher = + { on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + } + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher += + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + +module type A = sig + type t := A.t + + type a := A.a + and b := A.b + + type t := A.t = + | A + | B + + type t := + | A + | B + + type t := A.t = + { a : int + ; b : int + } + + and t := + { a : int + ; b : int + } + + type t := A.t = .. + type t := .. +end + +type t = + [ `A (** A *) + | `B [@b] (** B *) + | (p[@p]) (* P *) + ] + +type foooooooooooooooo = + ?fooooooooo:(string -> unit) + -> ?fooooooooooooo: + (string -> string -> int -> string -> string option foooooooooooooooooooooooo) + -> fooooo:string + -> ?fooooooooo:(unit -> unit Fooo.t) + -> ?fooooooo:bool + -> string option Foooooooo.t + +type ' a' t = ' a' +type ' a' t = ' a' option +type ' a' t = int as ' a' +type t = { a : ' a'. ' a' t' } + +type t = + | Foo + | (* Redirect (None, lib) looks up lib in the same database *) + Redirect of db option * (Loc.t * Lib_name.t) + +type t = + | Foo + | Store of + { exp1 : Exp.t + ; typ : Typ.t option + ; exp2 : Exp.t + ; loc : Location.t + } (** *exp1 <- exp2 with exp2:typ *) diff --git a/test/passing/refs.janestreet/types-sparse.ml.ref b/test/passing/refs.janestreet/types-sparse.ml.ref new file mode 100644 index 0000000000..a72a631603 --- /dev/null +++ b/test/passing/refs.janestreet/types-sparse.ml.ref @@ -0,0 +1,246 @@ +type uu = + | A of int + | B of (< leq : 'a > as 'a) + +type uu = + | A of int + | B of (< leq : 'a > as 'a) * 'a + +type uu = + | A of (int as 'a) + | B of 'a * (< leq : 'a > as 'a) + +type uu += A of (int as 'a) +type uu += B of 'a * (< leq : 'a > as 'a) + +let _ = ignore Async_unix.Fd.(([ stdin (); stdout (); stderr () ] : t list)) + +type t = { x : int } + +type t = + { a : int + ; b : int + } + +type t = + [ `A + | `B + ] + +type loooooooooong_type = + { looooooooooooong_field : looooooooooooong_type + ; field2 : type2 + } + +type t = A of (int * int) * int +type t = A of int * int +type t = A of (int * int) + +let _ = + match x with + | Some (Some None) -> t +;; + +type t = .. +type t = private .. +type t = u = private .. +type t += A +type t += B = A +type 'a foo = A of (int -> 'a) +type 'a foo += A of (int -> 'a) +type 'a foo += A : (int -> 'a) -> int foo +type t = [ | a ] +type t = private [< a ] +type t = private [> a ] + +type t = + [ a + | b + ] + +type t = + [ a + | b + | `C + ] + +type t = + [ `a + | b + ] + +type t = | +type t = [> ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int + | `Looooooooooooooooooooong_variant of string + ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int (** Doc *) + | `Looooooooooooooooooooong_variant of string (* Comment *) + ] + +let (`A | `B) [@bar] = () + +type t = + | Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string + | `Unstable of Location.t * string + ] + ] + +val x + : [ `X of int + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of + int * foooooooooooooo * fooooooooooo * fooooooooooo foooooooooo * foooooooooooo + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of int (* booooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of + int * foooooooooooooo * fooooooooooo * fooooooooooo foooooooooo * foooooooooooo + (* boooooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +type voting_period = Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + +(** foooooooo *) +type voting_period = + (* foooooooooooo *) + (* foooooooooo ooooooooooooooooo ooooooooooooo *) + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind + (* fooooooooooooooo oooooooooooooooooooo ooooooooooooooooooooo *) + (* fooooo *) = + (* foooooooooo *) + | Proposal + | Testing_vote (** fooooooooooo *) + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher = + { on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + } + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher = + ( 'context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint ) + templ_matcher = + { on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + } + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher += + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + +module type A = sig + type t := A.t + + type a := A.a + and b := A.b + + type t := A.t = + | A + | B + + type t := + | A + | B + + type t := A.t = + { a : int + ; b : int + } + + and t := + { a : int + ; b : int + } + + type t := A.t = .. + type t := .. +end + +type t = + [ `A (** A *) + | `B [@b] (** B *) + | (p[@p]) (* P *) + ] + +type foooooooooooooooo = + ?fooooooooo:(string -> unit) + -> ?fooooooooooooo: + (string -> string -> int -> string -> string option foooooooooooooooooooooooo) + -> fooooo:string + -> ?fooooooooo:(unit -> unit Fooo.t) + -> ?fooooooo:bool + -> string option Foooooooo.t + +type ' a' t = ' a' +type ' a' t = ' a' option +type ' a' t = int as ' a' +type t = { a : ' a'. ' a' t' } + +type t = + | Foo + | (* Redirect (None, lib) looks up lib in the same database *) + Redirect of db option * (Loc.t * Lib_name.t) + +type t = + | Foo + | Store of + { exp1 : Exp.t + ; typ : Typ.t option + ; exp2 : Exp.t + ; loc : Location.t + } (** *exp1 <- exp2 with exp2:typ *) diff --git a/test/passing/refs.janestreet/types.ml.ref b/test/passing/refs.janestreet/types.ml.ref new file mode 100644 index 0000000000..a72a631603 --- /dev/null +++ b/test/passing/refs.janestreet/types.ml.ref @@ -0,0 +1,246 @@ +type uu = + | A of int + | B of (< leq : 'a > as 'a) + +type uu = + | A of int + | B of (< leq : 'a > as 'a) * 'a + +type uu = + | A of (int as 'a) + | B of 'a * (< leq : 'a > as 'a) + +type uu += A of (int as 'a) +type uu += B of 'a * (< leq : 'a > as 'a) + +let _ = ignore Async_unix.Fd.(([ stdin (); stdout (); stderr () ] : t list)) + +type t = { x : int } + +type t = + { a : int + ; b : int + } + +type t = + [ `A + | `B + ] + +type loooooooooong_type = + { looooooooooooong_field : looooooooooooong_type + ; field2 : type2 + } + +type t = A of (int * int) * int +type t = A of int * int +type t = A of (int * int) + +let _ = + match x with + | Some (Some None) -> t +;; + +type t = .. +type t = private .. +type t = u = private .. +type t += A +type t += B = A +type 'a foo = A of (int -> 'a) +type 'a foo += A of (int -> 'a) +type 'a foo += A : (int -> 'a) -> int foo +type t = [ | a ] +type t = private [< a ] +type t = private [> a ] + +type t = + [ a + | b + ] + +type t = + [ a + | b + | `C + ] + +type t = + [ `a + | b + ] + +type t = | +type t = [> ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int + | `Looooooooooooooooooooong_variant of string + ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int (** Doc *) + | `Looooooooooooooooooooong_variant of string (* Comment *) + ] + +let (`A | `B) [@bar] = () + +type t = + | Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string + | `Unstable of Location.t * string + ] + ] + +val x + : [ `X of int + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of + int * foooooooooooooo * fooooooooooo * fooooooooooo foooooooooo * foooooooooooo + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of int (* booooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x + : [ `X of + int * foooooooooooooo * fooooooooooo * fooooooooooo foooooooooo * foooooooooooo + (* boooooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +type voting_period = Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + +(** foooooooo *) +type voting_period = + (* foooooooooooo *) + (* foooooooooo ooooooooooooooooo ooooooooooooo *) + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind + (* fooooooooooooooo oooooooooooooooooooo ooooooooooooooooooooo *) + (* fooooo *) = + (* foooooooooo *) + | Proposal + | Testing_vote (** fooooooooooo *) + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher = + { on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + } + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher = + ( 'context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint ) + templ_matcher = + { on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + ; on_objc_cpp : 'context -> 'f_in + } + +type ('context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint) + templ_matcher += + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + +module type A = sig + type t := A.t + + type a := A.a + and b := A.b + + type t := A.t = + | A + | B + + type t := + | A + | B + + type t := A.t = + { a : int + ; b : int + } + + and t := + { a : int + ; b : int + } + + type t := A.t = .. + type t := .. +end + +type t = + [ `A (** A *) + | `B [@b] (** B *) + | (p[@p]) (* P *) + ] + +type foooooooooooooooo = + ?fooooooooo:(string -> unit) + -> ?fooooooooooooo: + (string -> string -> int -> string -> string option foooooooooooooooooooooooo) + -> fooooo:string + -> ?fooooooooo:(unit -> unit Fooo.t) + -> ?fooooooo:bool + -> string option Foooooooo.t + +type ' a' t = ' a' +type ' a' t = ' a' option +type ' a' t = int as ' a' +type t = { a : ' a'. ' a' t' } + +type t = + | Foo + | (* Redirect (None, lib) looks up lib in the same database *) + Redirect of db option * (Loc.t * Lib_name.t) + +type t = + | Foo + | Store of + { exp1 : Exp.t + ; typ : Typ.t option + ; exp2 : Exp.t + ; loc : Location.t + } (** *exp1 <- exp2 with exp2:typ *) diff --git a/test/passing/refs.janestreet/unary.ml.ref b/test/passing/refs.janestreet/unary.ml.ref new file mode 100644 index 0000000000..f5428f13fc --- /dev/null +++ b/test/passing/refs.janestreet/unary.ml.ref @@ -0,0 +1,34 @@ +let _ = ~+2 +let _ = 2 +let _ = + ~-3 +let _ = -3 +let _ = ~+.2 +let _ = +.2 +let _ = ~-.3 +let _ = ~-3. +let _ = ~-(f x y) +let _ = -f x y +let _ = -f x y +let x = - !p +let x = - !p +let y = -r.f +let y = -r.f +let x = ~- (!p) +let x = ~- (!p) +let y = ~-r.f +let y = ~-r.f + +let _ = +f x +and _ = -f x + +let _ = +f x +and _ = -f x + +let _ = +.f x +and _ = -.f x + +let _ = +.f x +and _ = -.f x + +let _ = ~-(f r.x) +let _ = -(!array_ref.(0)) diff --git a/test/passing/refs.janestreet/unary_hash.ml.ref b/test/passing/refs.janestreet/unary_hash.ml.ref new file mode 100644 index 0000000000..bcbc7537ca --- /dev/null +++ b/test/passing/refs.janestreet/unary_hash.ml.ref @@ -0,0 +1,10 @@ +let f o x = o##x +let f x = !#x +let f x = ?#x +let f x = ~#x +let f o x = o#-#x +let f x = !-#x +let f x = ?-#x +let f x = ~-#x +let f x = ?#(x - y) +let f x = x + ?#(x + y) diff --git a/test/passing/refs.janestreet/unicode.ml.err b/test/passing/refs.janestreet/unicode.ml.err new file mode 100644 index 0000000000..802360524a --- /dev/null +++ b/test/passing/refs.janestreet/unicode.ml.err @@ -0,0 +1,4 @@ +Warning: unicode.ml:2 exceeds the margin +Warning: unicode.ml:4 exceeds the margin +Warning: unicode.ml:6 exceeds the margin +Warning: unicode.ml:8 exceeds the margin diff --git a/test/passing/refs.janestreet/unicode.ml.ref b/test/passing/refs.janestreet/unicode.ml.ref new file mode 100644 index 0000000000..67a75ead14 --- /dev/null +++ b/test/passing/refs.janestreet/unicode.ml.ref @@ -0,0 +1,9 @@ +(* Don't edit this file with an editor that perform unicode normalization *) + +(* normal78901234567890123456789012345678901234567890123456789012345678901 a bū c d e*) + +(* modifier901234567890123456789012345678901234567890123456789012345678901 a bū̃ c d e*) + +(* 12345678901234567890123456789012345678901234567890123456789012345678901 a yo c d e*) + +(* 12345678901234567890123456789012345678901234567890123456789012345678901 a y̲o c d e*) diff --git a/test/passing/refs.janestreet/use_file.mlt.ref b/test/passing/refs.janestreet/use_file.mlt.ref new file mode 100644 index 0000000000..938cdce59b --- /dev/null +++ b/test/passing/refs.janestreet/use_file.mlt.ref @@ -0,0 +1,19 @@ +#p + +#p "a" + +#p 0;; + +0;; + +#p 0n + +#p M.T.r + +(* comments *) +(* comments *) + +let () = 3;; + +2;; +3 diff --git a/test/passing/refs.janestreet/variants.ml.ref b/test/passing/refs.janestreet/variants.ml.ref new file mode 100644 index 0000000000..1c10a1c08e --- /dev/null +++ b/test/passing/refs.janestreet/variants.ml.ref @@ -0,0 +1,19 @@ +type t = + [ (* xx *) `(* yy *) A (* zz *) + | (* xx *) `B (* zz *) + | `(* yy *) C (* zz *) + ] + +let (* xx *) `(* yy *) A (* zz *) = x +let (* xx *) `B (* zz *) = x +let `(* yy *) C (* zz *) = x +let _ = (* xx *) `(* yy *) A (* zz *) +let _ = (* xx *) `B (* zz *) +let _ = `(* yy *) C (* zz *) + +type t = + [ `Fooooo + | (* Other inline element markup. *) + `Simple_reference of string + | `Fooooo + ] diff --git a/test/passing/refs.janestreet/verbatim_comments-wrap.ml.ref b/test/passing/refs.janestreet/verbatim_comments-wrap.ml.ref new file mode 100644 index 0000000000..64fc512d9a --- /dev/null +++ b/test/passing/refs.janestreet/verbatim_comments-wrap.ml.ref @@ -0,0 +1,24 @@ +(*= Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* [...] + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +[...] *) + +let _ = + (*= Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* [...] + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +[...] *) + () +;; diff --git a/test/passing/refs.janestreet/verbatim_comments.ml.ref b/test/passing/refs.janestreet/verbatim_comments.ml.ref new file mode 100644 index 0000000000..64fc512d9a --- /dev/null +++ b/test/passing/refs.janestreet/verbatim_comments.ml.ref @@ -0,0 +1,24 @@ +(*= Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* [...] + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +[...] *) + +let _ = + (*= Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* [...] + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +[...] *) + () +;; diff --git a/test/passing/refs.janestreet/w50.ml.ref b/test/passing/refs.janestreet/w50.ml.ref new file mode 100644 index 0000000000..a21ae0ea30 --- /dev/null +++ b/test/passing/refs.janestreet/w50.ml.ref @@ -0,0 +1,21 @@ +(* When using [--no-comment-check] (to format code despite warning 50), + We should not complain if doc-comments start appearing in the AST. +*) + +module type T = sig + val test_raises_some_exc : ('a -> 'b) -> 'a -> bool + + (** AAAA *) + + (** BBBB *) + val test_raises_this_exc : exn -> ('a -> 'b) -> 'a -> bool +end + +module T = struct + let test_raises_some_exc = 2 + + (** CCCC *) + + (** DDDD *) + let test_raises_this_exc = 3 +end diff --git a/test/passing/refs.janestreet/wrap_comments.ml.err b/test/passing/refs.janestreet/wrap_comments.ml.err new file mode 100644 index 0000000000..702d45460f --- /dev/null +++ b/test/passing/refs.janestreet/wrap_comments.ml.err @@ -0,0 +1,5 @@ +Warning: wrap_comments.ml:4 exceeds the margin +Warning: wrap_comments.ml:85 exceeds the margin +Warning: wrap_comments.ml:224 exceeds the margin +Warning: wrap_comments.ml:235 exceeds the margin +Warning: wrap_comments.ml:254 exceeds the margin diff --git a/test/passing/refs.janestreet/wrap_comments.ml.ref b/test/passing/refs.janestreet/wrap_comments.ml.ref new file mode 100644 index 0000000000..6b380baa79 --- /dev/null +++ b/test/passing/refs.janestreet/wrap_comments.ml.ref @@ -0,0 +1,271 @@ +[@@@ocamlformat "wrap-comments=true"] + +type t = + | Aaaaaaaaaa + (* Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. *) + | Bbbbbbbbbb + +let _ = + [ "a" + ; "b" + (* first line + second line *) + ; "c" + (* first line + + second line + *) + ; "d" + (* first line + + + second line *) + ; "e" + (* first line + + second line + *) + ; "f" + (* first line + + second line + *) + ; "g" + ] +;; + +let _ = + let _ = + (* This is indented 7 +This 0 *) + 0 + in + 0 +;; + +let _ = + (*no space before + no space after*) + 0 +;; + +let _ = + (* + blah blah + *) + () +;; + +(* + * foo + * bar +*) + +(* + * foo + bar +*) + +let _ = + f + (* foo + *) + a +;; + +(* 1 + * + 2 + * --- + * 3 +*) + +[@@@ocamlformat "wrap-comments=false"] + +type t = + | Aaaaaaaaaa + (* Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. *) + | Bbbbbbbbbb + +let rex = + Pcre.regexp + ("^[0-9]{2}" + (* xxxxxxxxxxx *) + ^ "(.{12})" + (* xxxxxxxxxxxxxxxxxx *) + ^ "(.{4})" + (* xxxxxxxxxxxx *) + ^ "([0-9]{3})" + (* xxxxxxxx *) + ^ "(.{60})" + (* xxxxxxxxxxxxxxxxxxxx *) + ^ "(.{12})" + (* xxxxxxxxxxxxxxx *) + ^ "(.{12})" + (* xxxxxxxxxxxxxxxxxxx *) + ^ "([0-9]{3})" + (* xxxxxxxxxxxxxxxxxxxxxxxxx *) + ^ "([0-9]{3})" + (* xxxxxxxxxxx *) + ^ "(.{15})" + (* xxxxxxxxxxxxxxxxxx *) + ^ "([0-9]{7})" + (* xxxxxxxxxxxxx *) + ^ "(.{10})" + (* xxxxxxxxxxxxx *) + ^ date_fmt + (* xxxxxxxxxxxxx *) + ^ "([0-9]{18})" + (* xxxxx *) + ^ "(.)" + (* xxxxxxxxxxx *) + ^ "([0-9]{3})" + (* xxxxxxxxxxxxxx *) + ^ "(.{15})" + (* xxxxxxxxxxxxxxxxxxxx *) + ^ "(.{3})" + (* xxxxxxxxxx *) + ^ "(.{27})$") +;; + +type foo = + { some_field : int + (* long long long long long long long long long long long long long long + * long long long long *) + ; another_field : string + } + +let _ = + [ "a" + ; "b" + (* first line + second line *) + ; "c" + (* first line + + second line + *) + ; "d" + (* first line + + + second line *) + ; "e" + (* first line + + second line + *) + ; "f" + (* first line + + second line + *) + ; "g" + ] +;; + +let _ = + let _ = + (* This is indented 7 +This 0 *) + 0 + in + 0 +;; + +let _ = + (*no space before + no space after*) + 0 +;; + +let _ = + (*no space before + just newline after + *) + 0 +;; + +let _ = + (* Optimal 5-element sorting network: + + {v + 1--o-----o-----o--------------1 + | | | + 2--o-----|--o--|-----o--o-----2 + | | | | | + 3--------o--o--|--o--|--o-----3 + | | | + 4-----o--------o--o--|-----o--4 + | | | + 5-----o--------------o-----o--5 + v} *) + () +;; + +let _ = + (* + blah blah + *) + () +;; + +(* + * foo + * bar +*) + +(* + * foo + bar +*) + +let _ = + (* It is very confusing - same expression has two different types in two contexts:*) + (* 1. if passed as parameter it's RETURN_TYPE* since we are passing it as rvalue *) + (* 2. for return expression it's RETURN_TYPE since backend allows to treat it as lvalue*) + (* of RETURN_TYPE *) + (* Implications: *) + (* Fields: field_deref_trans relies on it - if exp has RETURN_TYPE then *) + (* it means that it's not lvalue in clang's AST (it'd be reference otherwise) *) + (* Methods: method_deref_trans actually wants a pointer to the object, which is*) + (* equivalent of value of ret_param. Since ret_exp has type RETURN_TYPE,*) + (* we optionally add pointer there to avoid backend confusion. *) + (* It works either way *) + (* Passing by value: may cause problems - there needs to be extra Sil.Load, but*) + (* doing so would create problems with methods. Passing structs by*) + (* value doesn't work good anyway. This may need to be revisited later*) + let x = y in + z +;; + +let _ = + (* It is very confusing - same expression has two different types in two contexts: + * 1. if passed as parameter it's RETURN_TYPE* since we are passing it as rvalue + * 2. for return expression it's RETURN_TYPE since backend allows to treat it as lvalue + * of RETURN_TYPE + * Implications: + * Fields: field_deref_trans relies on it - if exp has RETURN_TYPE then + * it means that it's not lvalue in clang's AST (it'd be reference otherwise) + * Methods: method_deref_trans actually wants a pointer to the object, which is + * equivalent of value of ret_param. Since ret_exp has type RETURN_TYPE, + * we optionally add pointer there to avoid backend confusion. + * It works either way + * Passing by value: may cause problems - there needs to be extra Sil.Load, but + * doing so would create problems with methods. Passing structs by + * value doesn't work good anyway. This may need to be revisited later*) + let x = y in + z +;; + +let _ = + f + (* foo + *) + a +;; + +(* 1 + * + 2 + * --- + * 3 +*) diff --git a/test/passing/refs.janestreet/wrap_comments_break.ml.ref b/test/passing/refs.janestreet/wrap_comments_break.ml.ref new file mode 100644 index 0000000000..425a8a25ad --- /dev/null +++ b/test/passing/refs.janestreet/wrap_comments_break.ml.ref @@ -0,0 +1,9 @@ +let _ = + let _ = + fffffffffff + aaaaaaaaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbbbbbb + ~f:(fun x -> return xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx) + in + 2 +;; diff --git a/test/passing/refs.janestreet/wrap_invalid_doc_comments.ml.err b/test/passing/refs.janestreet/wrap_invalid_doc_comments.ml.err new file mode 100644 index 0000000000..ee04b36da2 --- /dev/null +++ b/test/passing/refs.janestreet/wrap_invalid_doc_comments.ml.err @@ -0,0 +1,6 @@ +Warning: Invalid documentation comment: +File "wrap_invalid_doc_comments.ml", line 2, characters 48-53: +'{v ... v}' (verbatim text) should begin on its own line. +Warning: Invalid documentation comment: +File "wrap_invalid_doc_comments.ml", line 2, characters 48-53: +'{v ... v}' (verbatim text) should not be empty. diff --git a/test/passing/refs.janestreet/wrap_invalid_doc_comments.ml.ref b/test/passing/refs.janestreet/wrap_invalid_doc_comments.ml.ref new file mode 100644 index 0000000000..5b38098d67 --- /dev/null +++ b/test/passing/refs.janestreet/wrap_invalid_doc_comments.ml.ref @@ -0,0 +1,2 @@ +(** - Item 1 + - Item 2, that contains two block elements: {v v} *) diff --git a/test/passing/refs.janestreet/wrapping_functor_args.ml.ref b/test/passing/refs.janestreet/wrapping_functor_args.ml.ref new file mode 100644 index 0000000000..0b3cb71917 --- /dev/null +++ b/test/passing/refs.janestreet/wrapping_functor_args.ml.ref @@ -0,0 +1,40 @@ +(* This declaration looks odd *) +type request_token = + Sociaml_oauth_client.Client.Make(Sociaml_oauth_client.Posix.Clock) + (Sociaml_oauth_client.Posix.MAC_SHA1) + (Sociaml_oauth_client.Posix.Random) + .request_token + +(* Whereas this one works well *) +module OauthClient = + Sociaml_oauth_client.Client.Make + (Sociaml_oauth_client.Posix.Clock) + (Sociaml_oauth_client.Posix.MAC_SHA1) + (Sociaml_oauth_client.Posix.Random) + +module F1 + (G : functor (_ : T) -> T) + (A : sig + val x : int + end) = +struct end + +module F2 + (G : functor (_ : T) -> + T_________________________________________________________________________) + (A : sig + val x : int + end) = +struct end + +module F3 + (G : functor (_ : T____________________________________________) + (_ : T____________________________________________) -> T) + (A : sig + val x : int + end) = +struct end + +module F (* test *) (M : sig + type t + end) : S = struct end diff --git a/test/passing/refs.ocamlformat/.ocamlformat b/test/passing/refs.ocamlformat/.ocamlformat new file mode 100644 index 0000000000..d06ffd04f2 --- /dev/null +++ b/test/passing/refs.ocamlformat/.ocamlformat @@ -0,0 +1 @@ +profile=ocamlformat diff --git a/test/passing/refs.ocamlformat/align_infix.ml.ref b/test/passing/refs.ocamlformat/align_infix.ml.ref new file mode 100644 index 0000000000..c468f7785a --- /dev/null +++ b/test/passing/refs.ocamlformat/align_infix.ml.ref @@ -0,0 +1,5 @@ +let sum_of_squares num = + num + 1 + |> List.range 0 + |> List.map ~f:square + |> List.fold_left ~init:0 ~f:( + ) diff --git a/test/passing/refs.ocamlformat/alignment.ml.err b/test/passing/refs.ocamlformat/alignment.ml.err new file mode 100644 index 0000000000..be42417c54 --- /dev/null +++ b/test/passing/refs.ocamlformat/alignment.ml.err @@ -0,0 +1 @@ +Warning: alignment.ml:7 exceeds the margin diff --git a/test/passing/refs.ocamlformat/alignment.ml.ref b/test/passing/refs.ocamlformat/alignment.ml.ref new file mode 100644 index 0000000000..567840e240 --- /dev/null +++ b/test/passing/refs.ocamlformat/alignment.ml.ref @@ -0,0 +1,17 @@ +let file_contents = [] @ [foo] @ [bar] + +let _ = + match s.src with + | None -> + [zz] + 2 + | Some s -> + [Variable (s_src, OpamFormat.make_string (OpamFilename.to_string s)); yy] ; + foo + | Some s -> + {fww= (s_src, OpamFormat.make_string (OpamFilename.to_string s)); gdd= yy} + +let _ = [x; y] @ z + +let _ = [x; y] @ z + +let _ = [x; y] @ z diff --git a/test/passing/refs.ocamlformat/apply.ml.ref b/test/passing/refs.ocamlformat/apply.ml.ref new file mode 100644 index 0000000000..80592b7297 --- /dev/null +++ b/test/passing/refs.ocamlformat/apply.ml.ref @@ -0,0 +1,89 @@ +let _ = List.map ~f:(( + ) (M.f x)) + +let id x = x + +let plus a ?(b = 0) c = a + b + c ;; + +id (plus 1) ~b:1 ;; + +(* The version above does not type-check, while the version below does + type-check, and should not be formatted to the above. See + https://caml.inria.fr/mantis/view.php?id=7832 for explanation on the + type-checking (and dynamic semantics) distinction. *) + +(id (plus 1)) ~b:1 + +let ( !!! ) a ~b = a + b + +let _ = ( !!! ) a b + +let _ = ( !!! ) ~b + +let _ = !!!!a b d + +let _ = ( + ) a b c d + +let cartesian_product l1 l2 = + List.concat (l1 |> List.map (fun v1 -> l2 |> List.map (fun v2 -> (v1, v2)))) + +let cartesian_product' long_list_one long_list_two = + List.concat + ( long_list_one + |> List.map (fun v1 -> long_list_two |> List.map (fun v2 -> (v1, v2))) ) + +let whatever a_function_name long_list_one some_other_thing = + List.map + (fun long_list_one_elt -> + do_something_with_a_function_and_some_things a_function_name + long_list_one_elt some_other_thing ) + long_list_one + +let whatever_labelled a_function_name long_list_one some_other_thing = + ListLabels.map long_list_one ~f:(fun long_list_one_elt -> + do_something_with_a_function_and_some_things a_function_name + long_list_one_elt some_other_thing ) + +[@@@ocamlformat "indicate-multiline-delimiters=closing-on-separate-line"] + +let cartesian_product' long_list_one long_list_two = + List.concat + (long_list_one + |> List.map (fun v1 -> long_list_two |> List.map (fun v2 -> (v1, v2))) + ) + +let whatever a_function_name long_list_one some_other_thing = + List.map + (fun long_list_one_elt -> + do_something_with_a_function_and_some_things a_function_name + long_list_one_elt some_other_thing + ) + long_list_one + +let whatever_labelled a_function_name long_list_one some_other_thing = + ListLabels.map long_list_one ~f:(fun long_list_one_elt -> + do_something_with_a_function_and_some_things a_function_name + long_list_one_elt some_other_thing + ) +;; + +(a - b) () ;; + +((a - b) [@foo]) () + +let _ = M.(loooooooooooooooooooooong + loooooooooooooooooong) + +let _ = + M.( + loooooooooooooooooooooong + loooooooooooooooooong + + llllllllllloooooooooooooooooonnnnnnnnnnnnnggggggggggg + ) + +let _ = + i'm_a_function loooooooooooong + (loooooooooooong looooooooooooooong loooooooooooooong + [loooooooooong; loooooooooooong; loooooooooooooooooooooong] + ) + +let f (x :: y) = x + +let f (* xx *) ((* aa *) x (* bb *) :: (* cc *) y (* dd *)) (* yy *) = x diff --git a/test/passing/refs.ocamlformat/apply_functor.ml.ref b/test/passing/refs.ocamlformat/apply_functor.ml.ref new file mode 100644 index 0000000000..4850426595 --- /dev/null +++ b/test/passing/refs.ocamlformat/apply_functor.ml.ref @@ -0,0 +1,7 @@ +module _ = F (functor (X : T) -> X) +module _ = + F + (functor + (X____________________________ : T) + -> + X____________________________) diff --git a/test/passing/refs.ocamlformat/args_grouped.ml.ref b/test/passing/refs.ocamlformat/args_grouped.ml.ref new file mode 100644 index 0000000000..557710a46a --- /dev/null +++ b/test/passing/refs.ocamlformat/args_grouped.ml.ref @@ -0,0 +1,93 @@ +let nullsafe_optimistic_third_party_params_in_non_strict = + CLOpt.mk_bool + ~long:"nullsafe-optimistic-third-party-params-in-non-strict" + (* Turned on for compatibility reasons. Historically this is because + there was no actionable way to change third party annotations. Now + that we have such a support, this behavior should be reconsidered, + provided our tooling and error reporting is friendly enough to be + smoothly used by developers. *) + ~default:true + "Nullsafe: in this mode we treat non annotated third party method params as if they were \ + annotated as nullable." + +let test_file_renamings_from_json = + let create_test test_input expected_output _ = + let test_output input = + DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.from_json input + in + foo + in + fooooooooooooooo + +let eval location exp0 astate = + let rec eval exp astate = + match (exp : Exp.t) with + | Var id -> + Ok (eval_var (* error in case of missing history? *) [] (Var.of_id id) astate) + | Lvar pvar -> + Ok (eval_var [ValueHistory.VariableAccessed (pvar, location)] (Var.of_pvar pvar) astate) + | Lfield (exp', field, _) -> + goooooooo + in + fooooooooooooooooooooo + +let declare_locals_and_ret tenv pdesc (prop_ : Prop.normal Prop.t) = + let foooooooooooooo = + BiabductionConfig.run_in_re_execution_mode + (* no footprint vars for locals *) + sigma_locals_and_ret () + in + fooooooooooooooooooooooooooo + +let bottom_up fooooooooooo = + let empty = Int.equal 0 !scheduled && Queue.is_empty pending in + if empty then ( + remaining := 0 ; + L.progress "Finished call graph scheduling, %d procs remaining (in, or reaching, cycles).@." + (CallGraph.n_procs syntactic_call_graph) ; + if Config.debug_level_analysis > 0 then CallGraph.to_dotty syntactic_call_graph "cycles.dot" ; + foooooooooooooooooo ) + else fooooooooooooooooo + +let test_file_renamings_from_json = + let fooooooooooooo = + match expected_output with + | Return exp -> + assert_equal ~pp_diff + ~cmp:DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.equal exp + (test_output test_input) + | Raise exc -> + assert_raises exc (fun () -> test_output test_input) + in + foooooooooooooooo + +let gen_with_record_deps ~expand t resolved_forms ~dep_kind = + let foooooooooooooooooooooo = + expand + (* we keep the dir constant here to replicate the old behavior of: + (chdir foo %{exe:bar}). This should lookup ./bar rather than + ./foo/bar *) + resolved_forms ~dir:t.dir ~dep_kind ~expand_var:t.expand_var + in + {t with expand_var} + +let f = + very_long_function_name + ~very_long_variable_name:(very_long expression) + (* this is a + multiple-line-spanning + comment *) + ~y + +let eradicate_meta_class_is_nullsafe = + register ~id:"ERADICATE_META_CLASS_IS_NULLSAFE" + ~hum:"Class is marked @Nullsafe and has 0 issues" + (* Should be enabled for special integrations *) + ~enabled:false Info Eradicate (* TODO *) + ~user_documentation:"" + +let eradicate_meta_class_is_nullsafe = + register ~id:"ERADICATE_META_CLASS_IS_NULLSAFE" (* Should be enabled for special integrations *) + ~hum:"Class is marked @Nullsafe and has 0 issues" + (* Should be enabled for special integrations *) + ~enabled:false Info diff --git a/test/passing/refs.ocamlformat/array.ml.ref b/test/passing/refs.ocamlformat/array.ml.ref new file mode 100644 index 0000000000..8edf719105 --- /dev/null +++ b/test/passing/refs.ocamlformat/array.ml.ref @@ -0,0 +1,39 @@ +[| 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 |] + +let f = function + | [| 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 + ; 1222222 |] -> + () diff --git a/test/passing/refs.ocamlformat/assignment_operator-op_begin_line.ml.err b/test/passing/refs.ocamlformat/assignment_operator-op_begin_line.ml.err new file mode 100644 index 0000000000..7fd4f92be9 --- /dev/null +++ b/test/passing/refs.ocamlformat/assignment_operator-op_begin_line.ml.err @@ -0,0 +1 @@ +Warning: assignment_operator-op_begin_line.ml:60 exceeds the margin diff --git a/test/passing/tests/assignment_operator-op_begin_line.ml.ref b/test/passing/refs.ocamlformat/assignment_operator-op_begin_line.ml.ref similarity index 92% rename from test/passing/tests/assignment_operator-op_begin_line.ml.ref rename to test/passing/refs.ocamlformat/assignment_operator-op_begin_line.ml.ref index 4bc3285fa1..164589e53a 100644 --- a/test/passing/tests/assignment_operator-op_begin_line.ml.ref +++ b/test/passing/refs.ocamlformat/assignment_operator-op_begin_line.ml.ref @@ -28,19 +28,15 @@ let foo = foo let _ = - r (* _________________________________________________________________ *) - := 1 + r (* _________________________________________________________________ *) := 1 let _ = r (* _________________________________________________________________ *) - (* _________________________________________________________________ *) - := 1 + (* _________________________________________________________________ *) := 1 let _ = - r - := (* _________________________________________________________________ *) - 1 + r := (* _________________________________________________________________ *) 1 let _ = r @@ -50,8 +46,7 @@ let _ = let _ = r (* _________________________________________________________________ *) - := (* _________________________________________________________________ *) - 1 + := (* _________________________________________________________________ *) 1 let _ = r diff --git a/test/passing/refs.ocamlformat/assignment_operator.ml.err b/test/passing/refs.ocamlformat/assignment_operator.ml.err new file mode 100644 index 0000000000..95b7f0713f --- /dev/null +++ b/test/passing/refs.ocamlformat/assignment_operator.ml.err @@ -0,0 +1 @@ +Warning: assignment_operator.ml:60 exceeds the margin diff --git a/test/passing/tests/assignment_operator.ml.ref b/test/passing/refs.ocamlformat/assignment_operator.ml.ref similarity index 86% rename from test/passing/tests/assignment_operator.ml.ref rename to test/passing/refs.ocamlformat/assignment_operator.ml.ref index 4355d24b38..2433fa27f1 100644 --- a/test/passing/tests/assignment_operator.ml.ref +++ b/test/passing/refs.ocamlformat/assignment_operator.ml.ref @@ -13,12 +13,10 @@ let foo = value_end := entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest ; value_end := - ( entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest - ) + ( entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest ) [@foo] ; value_end := - ( entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest - ) + ( entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest ) [@foo] (* fooooooooooooo *) ; (* foooooooooooooooooooo *) @@ -28,9 +26,7 @@ let foo = foo let _ = - r - (* _________________________________________________________________ *) - := 1 + r (* _________________________________________________________________ *) := 1 let _ = r @@ -39,8 +35,7 @@ let _ = := 1 let _ = - r := - (* _________________________________________________________________ *) 1 + r := (* _________________________________________________________________ *) 1 let _ = r := @@ -49,9 +44,7 @@ let _ = 1 let _ = - r - (* _________________________________________________________________ *) - := + r (* _________________________________________________________________ *) := (* _________________________________________________________________ *) 1 let _ = diff --git a/test/passing/refs.ocamlformat/attribute_and_expression.ml.ref b/test/passing/refs.ocamlformat/attribute_and_expression.ml.ref new file mode 100644 index 0000000000..5639600d90 --- /dev/null +++ b/test/passing/refs.ocamlformat/attribute_and_expression.ml.ref @@ -0,0 +1,13 @@ +let _ = f (2 [@test 2]) + +let tail1 = [1; 2] [@hello] + +let tail2 = 0 :: ([1; 2] [@hello]) + +let tail3 = 0 :: ([] [@hello]) + +let _ = ("%d" : _ format) [@p] + +let _ = (`B `N : p2) [@p] + +let _ = (`So (`Se (`So `O)) : podd) [@p] diff --git a/test/passing/refs.ocamlformat/attributes.ml.err b/test/passing/refs.ocamlformat/attributes.ml.err new file mode 100644 index 0000000000..f2d45e1869 --- /dev/null +++ b/test/passing/refs.ocamlformat/attributes.ml.err @@ -0,0 +1,3 @@ +Warning: attributes.ml:343 exceeds the margin +Warning: attributes.ml:347 exceeds the margin +Warning: attributes.ml:370 exceeds the margin diff --git a/test/passing/refs.ocamlformat/attributes.ml.ref b/test/passing/refs.ocamlformat/attributes.ml.ref new file mode 100644 index 0000000000..07cc47a0d3 --- /dev/null +++ b/test/passing/refs.ocamlformat/attributes.ml.ref @@ -0,0 +1,457 @@ +[%foo type[@foo] t = < .. > ] + +let _ = (function[@warning "-4"] None -> true | _ -> false) None + +let f (x [@warning ""]) = () + +let v = (fun [@inline] x -> x) 1 + +external f : (float[@unboxed]) -> int = "blah" [@@noalloc] + +val x : ?x:unit (** not dropped *) -> unit + +type t = + { a: int + ; b: int [@default 1] [@drop_if] + ; c: int [@default 1] [@drop_if] + (** docstring that is long enough to break *) } + +type t = + { a: int + ; b: someloooooooooooooooooooooooooooooong typ + [@default looooooooooooooooooooooooooooooooooooooooong] + [@drop_if somethingelse] + ; b: somelong typ [@default 1] + ; c: someloooooooooooooooooooooooooooooong typ + [@default looooooooooooooooooooooooooooooooooooooooong] + [@drop_if somethingelse] + (** docstring that is long enough to break *) } + +val foo : int +[@@deprecated "it is good the salad"] [@@warning "-32"] [@@warning "-99"] + +val foo : int +[@@deprecated "it is good the salad"] +[@@warning "-32"] +[@@warning "-99"] +[@@some long comment] + +type t = A of int [@attr] | B of (float[@attr]) | C [@attr] + +type t = [`A of int [@attr] | `B of (float[@attr]) | `C [@attr]] + +let[@inline always] f x = + let[@something] e = 1 in + e + +module type M = S [@test1] + +module type M = sig + module T (T : sig end) : (S with type t = r [@test2]) + + module T (S : S [@test]) : S + + module T : (S with type t = (r[@test3]) [@test4]) + + module T : + (S + with type t = t + and type u := u + and module R = R + and module S := S + [@test]) + + module T : module type of X [@test5] + + module T : (module type of X) [@test6] + + module T : [%ext] [@test7] + + module T = T [@@test8] + module [@test8] T = T +end + +let f = fun [@inline] [@inline never] x -> x + +let g = fun [@inline] [@something_else] [@ocaml.inline] x -> x + +let h x = (g [@inlined] [@ocaml.inlined never]) x + +let v = (fun [@inline] [@inlined] x -> x) 1 + +let[@inline] i = fun [@inline] x -> x ;; + +if [@test] true then () else () ;; + +if [@test] true then () else if [@test] true then () else () + +let _ = ((A [@test]), (() [@test]), ([] [@test]), [||] [@test]) + +type blocklist = + { f1: int [@version 1, 1, 0] (** short comment *) + ; f2: (int64 * int64) list + (** loooooooooooooooooooooooooooooong + commmmmmmmmmmmmmmmmmmmmmmmmmmmmmmment *) + } + +type blocklist = + | F1 of int [@version 1, 1, 0] (** short comment *) + | F2 : int -> blocklist [@version 1, 1, 0] (** short comment *) + | F3 of (int64 * int64) list + (** loooooooooooooooooooooooooooooong + commmmmmmmmmmmmmmmmmmmmmmmmmmmmmmment *) + +type u = + | C of int * int + [@doc + [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit. " + ; "Etiam vel mauris fermentum, condimentum quam a, porta nisi" ]] +[@@deriving something] +[@@doc ["Ut at dolor a eros venenatis maximus ut at nisi."]] + +let ((A, B) [@test]) = () + +let ((lazy a) [@test]) = () + +let ((exception a) [@test]) = () + +let ((B x) [@test]) = () + +let ((`B x) [@test]) = () + +let (B [@test]) = () + +let (`B [@test]) = () + +let (B.(A) [@test]) = () + +let ('x' .. 'z' [@test]) = () + +let (#test [@test]) = () + +let ((module X) [@test]) = () + +let (a [@test]) = () + +let (_ [@test]) = () + +let ("" [@test]) = () + +let _ = f x ~f:(fun [@test] x -> x) + +let _ = f x ~f:(function [@test] x -> x) + +let _ = f x ~f:(function [@test] X -> x | X -> x) + +let () = () + +and[@warning "-32"] f = () + +external x : a -> b -> (a -> b[@test]) = "" + +let f = fun [@test] x y -> () + +let f y = fun [@test] y -> () + +let (f [@test]) = fun y -> fun [@test] y -> () + +module type T = sig + class subst : ((ident -> ident)[@attr]) -> (ident -> ident) -> object + inherit mapper + end[@attr] +end + +let _ = fun [@inlined always] x y -> z + +let () = assert ((assert false [@imp Show]) 1.0 = "1.") + +let () = f (assert false) + +let _ = match x with A -> [%expr match y with e -> e] + +let _ = + match x with A -> [%expr match y with e -> ( match e with x -> x )] + +type t = {a: int} +[@@deriving xxxxxxxxxxxxxxxxxxxxxxxxxxx] +(* comment *) +[@@deriving xxxxxxxxxxxxxxxxxxxxxxxxxxx] + +module type A = sig + module A := A.B [@@attr] +end + +module M = struct + type t + [@@immediate] + (* ______________________________________ *) + [@@deriving variants, sexp_of] +end + +let _ = {<>} [@a] + +let _ = f ({<>} [@a]) + +let _ = {<x = 1>} [@a] + +let _ = f ({<x = 1>} [@a]) + +let _ = (x :> t) [@a] + +let _ = f ((x :> t) [@a]) + +let _ = (module M) [@a] + +let _ = f ((module M) [@a]) + +let _ = (module M : S) [@a] + +let _ = f ((module M : S) [@a]) + +let _ = ([] @ []) [@a] + +(* Infix operator should left-align with the inner parens *) +let _ = + f + (( a_____________________________________ + @ b_____________________________________ ) + [@a] ) + +(* Attribute should wrap as a block *) +let _ = + ( a_______________________________________________________________________ + @ b________________________________________________________________ ) + [@a] + +let _ = + ( a_________________________________________________________________ + @ b_________________________________________________________________ ) + [@a] + +let _ = f (([] @ []) [@a]) + +let _ = ("" ^ "") [@a] + +let _ = f (("" ^ "") [@a]) + +let _ = (0 + 0) [@a] + +let _ = f ((0 + 0) [@a]) + +let _ = (a.x <- 1) [@a] + +let _ = f ((a.x <- 1) [@a]) + +let _ = (f @@ a) [@attr] + +let _ = f ((f @@ a) [@attr]) + +let _ = f 1 ([e; f] [@a]) + +let _ = f 1 ([|e; f|] [@a]) + +let _ = + object + method g = (a <- b) [@a] + + method h = f ((a <- b) [@a]) + + method i = + (a <- b) [@a] ; + () + end + +let _ = a.(b) [@a] + +let _ = f (a.(b) [@a]) + +let _ = (a.*?!@{b} <- c) [@a] + +let _ = f ((a.*?!@{b} <- c) [@a]) ;; + +(* Regression tests for https://github.com/ocaml-ppx/ocamlformat/issues/1256 + (dropped parentheses around tuples with attributes). *) + +(0, 0) [@a] + +let _ = ((0, 0) [@a]) + +let _ = f ((0, 0) [@a]) ;; + +(* Ensure that adding an attribute doesn't break left-alignment of tuple + components *) + +( a________________________________________ +, b________________________________________ ) +[@a] + +let _ = + f + (( a________________________________________ + , b________________________________________ ) + [@a] ) + +let _ = a [@a] ; b + +let _ = f (a [@a] ; b) + +let _ = a ; b [@a] + +let _ = f (a ; b [@a]) + +let _ = (a ; b) [@a] + +let _ = f ((a ; b) [@a]) + +let _ = a ; b [@a] ; c + +let _ = + a ; + (b1 ; b2) [@a] + +let _ = + a ; + (b1 ; b2) [@a] ; + c + +(* Ensure that adding an attribute doesn't break left-alignment of sequenced + expressions *) +let _ = + (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa ; + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ) + [@a] + +[@@@a (**b*)] + +let (Foo ((A | B) [@attr])) = () + +let ([(A | B) [@attr]; b; c] [@attr]) = () + +let ([|a; (A | B) [@attr]; c|] [@attr]) = () + +let {b= (A | B) [@attr]} = () + +let (`Foo ((`A | `B) [@attr])) = () + +let (A | B) [@attr], (A | B) [@attr] = () + +let (A | B) [@attr] = () + +let (Foo ((A | B) [@attr]) : (t[@attr])) = () + +let (M.(A | B) [@attr]) = () ;; + +(a_______________________________________________________________________________ +[@attr]) () +;; + +(a_______________________________________, b____________________________________) +[@attr] +;; + +{a____________________________________= b___________________________________} +[@attr] + +let _ = + (match[@ocaml.warning "-4"] bar with _ -> ()) ; + foo + +let _ = + (try[@ocaml.warning "-4"] bar with _ -> ()) ; + foo + +let pp f ({cf_interface; cf_is_objc_block; cf_virtual} [@warning "+9"]) = () + +let pp f + ({cf_assign_last_arg; cf_injected_destructor; cf_interface} [@warning "+9"]) + = + () + +let pp f + ({cf_assign_last_arg; cf_injected_destructor; cf_interface; cf_is_objc_block} + [@warning "+9"] ) = + () + +let _ = f ((* comments *) "c" [@attributes]) + +let _ = f ((* comments *) 'c' [@attributes]) + +let _ = function ("foo" [@attr]) -> ("bar" [@attr2]) + +let _ = function ('A' [@attr]) -> ('B' [@attr2]) | ('A' .. 'B' [@attr2]) -> () + +let _ = + match x with + | _ + when f + ~f:(function [@ocaml.warning + (* ....................................... *) + "-4"] _ -> . ) -> + y + +let[@a + (* .............................................. + ........................... .......................... + ...................... *) + foo + (* ....................... *) + (* ................................. *) + (* ...................... *)] _ = + match[@ocaml.warning (* ....................................... *) "-4"] + x [@attr (* .......................... .................. *) some_attr] + with + | _ + when f + ~f:(function[@ocaml.warning + (* ....................................... *) "-4"] + | _ -> . ) + ~f:(function[@ocaml.warning + (* ....................................... *) + (* ....................................... *) + "foooooooooooooooooooooooooooo \ + fooooooooooooooooooooooooooooooooooooo"] _ -> . ) + ~f:(function[@ocaml.warning + (* ....................................... *) + let x = a and y = b in + x + y] _ -> . ) -> + y + [@attr + (* ... *) + (* ... *) + attr (* ... *)] + +let raise_length_mismatch name n1 n2 = + invalid_argf "length mismatch in %s: %d <> %d" name n1 n2 () +[@@cold] [@@inline never] [@@local never] [@@specialise never] + +external unsafe_memset : t -> pos:int -> len:int -> char -> unit + = "bigstring_memset_stub" +[@@noalloc] + +let _ = f ((1 : int) [@a]) + +let _ = f ((1 : int) [@a]) ((1 : int) [@a]) + +let _ = f ((((1 : int) [@a]) : (int[@b])) [@a]) ((1 : int) [@a]) + +include [@foo] M [@boo] + +let () = + let () = + S.ntyp Cbor_type.Reserved + @@ S.tok + begin [@warning "-4"] + fun ev -> + match ev with Cbor_event.Reserved int -> Some int | _ -> None + end + in + () + +let () = + let () = + S.ntyp Cbor_type.Reserved + @@ (S.tok (fun ev -> + match ev with Cbor_event.Reserved int -> Some int | _ -> None ) + [@warning "-4"] ) + in + () diff --git a/test/passing/refs.ocamlformat/attributes.mli.ref b/test/passing/refs.ocamlformat/attributes.mli.ref new file mode 100644 index 0000000000..c7bece0879 --- /dev/null +++ b/test/passing/refs.ocamlformat/attributes.mli.ref @@ -0,0 +1,8 @@ +[@@@ocaml.doc "_"] + +val f : int -> int -> int +[@@cold] [@@inline never] [@@local never] [@@specialise never] + +external unsafe_memset : t -> pos:int -> len:int -> char -> unit + = "bigstring_memset_stub" +[@@noalloc] diff --git a/test/passing/refs.ocamlformat/binders.ml.ref b/test/passing/refs.ocamlformat/binders.ml.ref new file mode 100644 index 0000000000..9b0f2eaae2 --- /dev/null +++ b/test/passing/refs.ocamlformat/binders.ml.ref @@ -0,0 +1,17 @@ +external f : 'a -> 'a = "asdf" + +external g : + 'aaaaaaa 'aaaaaaaaaaaaaaa 'aaaaaaaaaaaaaaaaaaaaaa 'aaaaaaaaaaaaaa 'aaaaaaa + 'fooooo_foooooo. 'a -> 'a -> 'a = "asdf" + +type f = Foo : 'a -> t + +type f = Foo : 'a -> 'a + +type g = Foo : 'a. 'a -> t + +type g = + | Foo : + 'aaaaaaaaaaa 'bbbbbbbbbbbbbb 'ccccccccccccccc 'fooooo_fooooooo. + 'foo + -> 'b diff --git a/test/passing/refs.ocamlformat/break_before_in-auto.ml.err b/test/passing/refs.ocamlformat/break_before_in-auto.ml.err new file mode 100644 index 0000000000..c72b419650 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_before_in-auto.ml.err @@ -0,0 +1 @@ +Warning: break_before_in-auto.ml:2 exceeds the margin diff --git a/test/passing/refs.ocamlformat/break_before_in-auto.ml.ref b/test/passing/refs.ocamlformat/break_before_in-auto.ml.ref new file mode 100644 index 0000000000..27c55227d7 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_before_in-auto.ml.ref @@ -0,0 +1,55 @@ +let flat : unit = + let short = 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let fooo = 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let baaar = + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let long = + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let longer = + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + let longeerer = + 11 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + let longest = + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + + 11 + 11 + 11 + 11 in + let violate_margin = + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in + let violate_margin = + 1 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in + let violate_margin = + 1 + 11 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in + let violate_margin = + 1 + 111 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in + () + +let nested : unit = + let short = + let fooo = + let baaar = + let long = + let longer = + let longeerer = + let violate_margin = + let longest = + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + + 11 + 11 + 11 + 11 + 11 + 11 in + longest + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + 1 + 1111 + 1 in + violate_margin + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + 1 + 1 + 1 + 1 + 1 + 1 in + longeerer + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + 1 + 1 + 1 + 1 in + longer + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + 1 in + long + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + baaar + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + fooo + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + () diff --git a/test/passing/refs.ocamlformat/break_before_in.ml.ref b/test/passing/refs.ocamlformat/break_before_in.ml.ref new file mode 100644 index 0000000000..2dcbbbf4bf --- /dev/null +++ b/test/passing/refs.ocamlformat/break_before_in.ml.ref @@ -0,0 +1,66 @@ +let flat : unit = + let short = 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 in + let fooo = + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + let baaar = + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + let long = + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + let longer = + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + let longeerer = + 11 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + let longest = + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + + 11 + 11 + 11 + 11 + in + let violate_margin = + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in + let violate_margin = + 1 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in + let violate_margin = + 1 + 11 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in + let violate_margin = + 1 + 111 + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1111 + 1 + in + () + +let nested : unit = + let short = + let fooo = + let baaar = + let long = + let longer = + let longeerer = + let violate_margin = + let longest = + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + 11 + + 11 + 11 + 11 + 11 + 11 + 11 + in + longest + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + 1 + 1111 + 1 + in + violate_margin + 11 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + 1 + 1 + 1 + 1 + 1 + 1 + in + longeerer + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + 1 + 1 + 1 + 1 + in + longer + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + 1 + in + long + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + baaar + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + fooo + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + in + () diff --git a/test/passing/refs.ocamlformat/break_cases-align.ml.err b/test/passing/refs.ocamlformat/break_cases-align.ml.err new file mode 100644 index 0000000000..d0381b1d05 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_cases-align.ml.err @@ -0,0 +1,3 @@ +Warning: break_cases-align.ml:241 exceeds the margin +Warning: break_cases-align.ml:249 exceeds the margin +Warning: break_cases-align.ml:260 exceeds the margin diff --git a/test/passing/tests/break_cases-align.ml.ref b/test/passing/refs.ocamlformat/break_cases-align.ml.ref similarity index 96% rename from test/passing/tests/break_cases-align.ml.ref rename to test/passing/refs.ocamlformat/break_cases-align.ml.ref index 5230e91697..f8f4e08e1e 100644 --- a/test/passing/tests/break_cases-align.ml.ref +++ b/test/passing/refs.ocamlformat/break_cases-align.ml.ref @@ -75,8 +75,7 @@ let _ = let f x y = match x with | None -> false - | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong - -> + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> match y with | Some _ -> true | None -> false @@ -254,19 +253,19 @@ let _ = let foooooooooooooo = function | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) - | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) | Foooooooooooooooo (* foooooo foooo fooooooooooo *) | Foooooooooooooo _ (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. - Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo - foooooooooooooooooo foooooooo. Foooooooooooo fooooooooooo fooooooooooooo - foooooooooooooo foooooo. *) + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) | Foooooooooo | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) | Foooo - (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo - fooo *) -> + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> Foooooooooo.Foooooo | Foooo {foooo_fooo= {foooooooooo}} -> Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo @@ -275,8 +274,8 @@ let get_nullability = function | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) | Undef - (* This is a very special case, assigning non-null is a technical - trick *) -> + (* This is a very special case, assigning non-null is a technical trick *) + -> Nullability.Nonnull let _ = diff --git a/test/passing/refs.ocamlformat/break_cases-all.ml.err b/test/passing/refs.ocamlformat/break_cases-all.ml.err new file mode 100644 index 0000000000..847d4b3265 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_cases-all.ml.err @@ -0,0 +1,3 @@ +Warning: break_cases-all.ml:241 exceeds the margin +Warning: break_cases-all.ml:249 exceeds the margin +Warning: break_cases-all.ml:260 exceeds the margin diff --git a/test/passing/tests/break_cases-all.ml.ref b/test/passing/refs.ocamlformat/break_cases-all.ml.ref similarity index 96% rename from test/passing/tests/break_cases-all.ml.ref rename to test/passing/refs.ocamlformat/break_cases-all.ml.ref index 81947a33c2..7e42a5c3a9 100644 --- a/test/passing/tests/break_cases-all.ml.ref +++ b/test/passing/refs.ocamlformat/break_cases-all.ml.ref @@ -75,8 +75,7 @@ let _ = let f x y = match x with | None -> false - | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong - -> ( + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( match y with | Some _ -> true | None -> false ) @@ -254,19 +253,19 @@ let _ = let foooooooooooooo = function | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) - | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) | Foooooooooooooooo (* foooooo foooo fooooooooooo *) | Foooooooooooooo _ (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. - Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo - foooooooooooooooooo foooooooo. Foooooooooooo fooooooooooo fooooooooooooo - foooooooooooooo foooooo. *) + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) | Foooooooooo | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) | Foooo - (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo - fooo *) -> + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> Foooooooooo.Foooooo | Foooo {foooo_fooo= {foooooooooo}} -> Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo @@ -275,8 +274,8 @@ let get_nullability = function | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) | Undef - (* This is a very special case, assigning non-null is a technical - trick *) -> + (* This is a very special case, assigning non-null is a technical trick *) + -> Nullability.Nonnull let _ = diff --git a/test/passing/refs.ocamlformat/break_cases-closing_on_separate_line.ml.err b/test/passing/refs.ocamlformat/break_cases-closing_on_separate_line.ml.err new file mode 100644 index 0000000000..90a845a549 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_cases-closing_on_separate_line.ml.err @@ -0,0 +1,3 @@ +Warning: break_cases-closing_on_separate_line.ml:254 exceeds the margin +Warning: break_cases-closing_on_separate_line.ml:263 exceeds the margin +Warning: break_cases-closing_on_separate_line.ml:275 exceeds the margin diff --git a/test/passing/tests/break_cases-closing_on_separate_line.ml.ref b/test/passing/refs.ocamlformat/break_cases-closing_on_separate_line.ml.ref similarity index 96% rename from test/passing/tests/break_cases-closing_on_separate_line.ml.ref rename to test/passing/refs.ocamlformat/break_cases-closing_on_separate_line.ml.ref index f86688822b..abefcc598b 100644 --- a/test/passing/tests/break_cases-closing_on_separate_line.ml.ref +++ b/test/passing/refs.ocamlformat/break_cases-closing_on_separate_line.ml.ref @@ -83,8 +83,7 @@ let _ = let f x y = match x with | None -> false - | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong - -> ( + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( match y with | Some _ -> true | None -> false @@ -269,19 +268,19 @@ let _ = let foooooooooooooo = function | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) - | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) | Foooooooooooooooo (* foooooo foooo fooooooooooo *) | Foooooooooooooo _ (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. - Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo - foooooooooooooooooo foooooooo. Foooooooooooo fooooooooooo fooooooooooooo - foooooooooooooo foooooo. *) + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) | Foooooooooo | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) | Foooo - (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo - fooo *) -> + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> Foooooooooo.Foooooo | Foooo {foooo_fooo= {foooooooooo}} -> Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo @@ -290,8 +289,8 @@ let get_nullability = function | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) | Undef - (* This is a very special case, assigning non-null is a technical - trick *) -> + (* This is a very special case, assigning non-null is a technical trick *) + -> Nullability.Nonnull let _ = diff --git a/test/passing/refs.ocamlformat/break_cases-closing_on_separate_line_fit_or_vertical.ml.err b/test/passing/refs.ocamlformat/break_cases-closing_on_separate_line_fit_or_vertical.ml.err new file mode 100644 index 0000000000..97ba4258a3 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_cases-closing_on_separate_line_fit_or_vertical.ml.err @@ -0,0 +1,3 @@ +Warning: break_cases-closing_on_separate_line_fit_or_vertical.ml:215 exceeds the margin +Warning: break_cases-closing_on_separate_line_fit_or_vertical.ml:223 exceeds the margin +Warning: break_cases-closing_on_separate_line_fit_or_vertical.ml:235 exceeds the margin diff --git a/test/passing/tests/break_cases-closing_on_separate_line_fit_or_vertical.ml.ref b/test/passing/refs.ocamlformat/break_cases-closing_on_separate_line_fit_or_vertical.ml.ref similarity index 94% rename from test/passing/tests/break_cases-closing_on_separate_line_fit_or_vertical.ml.ref rename to test/passing/refs.ocamlformat/break_cases-closing_on_separate_line_fit_or_vertical.ml.ref index 6f1e8ec395..1932f02e2f 100644 --- a/test/passing/tests/break_cases-closing_on_separate_line_fit_or_vertical.ml.ref +++ b/test/passing/refs.ocamlformat/break_cases-closing_on_separate_line_fit_or_vertical.ml.ref @@ -1,6 +1,5 @@ let f x = function - | C | P (this, test, [is; wide; enough; _to; break], [the; line]) | A | K - -> 1 + | C | P (this, test, [is; wide; enough; _to; break], [the; line]) | A | K -> 1 | D -> let a = "this" in let b = "breaks" in @@ -71,8 +70,7 @@ let _ = let f x y = match x with | None -> false - | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong - -> ( + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( match y with | Some _ -> true | None -> false @@ -230,28 +228,27 @@ let _ = let foooooooooooooo = function | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) - | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) | Foooooooooooooooo (* foooooo foooo fooooooooooo *) | Foooooooooooooo _ (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. - Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo - foooooooooooooooooo foooooooo. Foooooooooooo fooooooooooo fooooooooooooo - foooooooooooooo foooooo. *) + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) | Foooooooooo | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) | Foooo - (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo - fooo *) -> Foooooooooo.Foooooo + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> Foooooooooo.Foooooo | Foooo {foooo_fooo= {foooooooooo}} -> Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo let get_nullability = function - | ArrayAccess - | OptimisticFallback (* non-null is the most optimistic type *) + | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) | Undef - (* This is a very special case, assigning non-null is a technical - trick *) -> Nullability.Nonnull + (* This is a very special case, assigning non-null is a technical trick *) + -> Nullability.Nonnull let _ = try () diff --git a/test/passing/refs.ocamlformat/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err b/test/passing/refs.ocamlformat/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err new file mode 100644 index 0000000000..3cda691d4e --- /dev/null +++ b/test/passing/refs.ocamlformat/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.err @@ -0,0 +1,3 @@ +Warning: break_cases-closing_on_separate_line_leading_nested_match_parens.ml:254 exceeds the margin +Warning: break_cases-closing_on_separate_line_leading_nested_match_parens.ml:263 exceeds the margin +Warning: break_cases-closing_on_separate_line_leading_nested_match_parens.ml:275 exceeds the margin diff --git a/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref b/test/passing/refs.ocamlformat/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref similarity index 96% rename from test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref rename to test/passing/refs.ocamlformat/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref index 4c77a95b53..bad267ca82 100644 --- a/test/passing/tests/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref +++ b/test/passing/refs.ocamlformat/break_cases-closing_on_separate_line_leading_nested_match_parens.ml.ref @@ -83,8 +83,7 @@ let _ = let f x y = match x with | None -> false - | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong - -> + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( match y with | Some _ -> true | None -> false @@ -269,19 +268,19 @@ let _ = let foooooooooooooo = function | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) - | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) | Foooooooooooooooo (* foooooo foooo fooooooooooo *) | Foooooooooooooo _ (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. - Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo - foooooooooooooooooo foooooooo. Foooooooooooo fooooooooooo fooooooooooooo - foooooooooooooo foooooo. *) + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) | Foooooooooo | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) | Foooo - (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo - fooo *) -> + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> Foooooooooo.Foooooo | Foooo {foooo_fooo= {foooooooooo}} -> Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo @@ -290,8 +289,8 @@ let get_nullability = function | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) | Undef - (* This is a very special case, assigning non-null is a technical - trick *) -> + (* This is a very special case, assigning non-null is a technical trick *) + -> Nullability.Nonnull let _ = diff --git a/test/passing/refs.ocamlformat/break_cases-cosl_lnmp_cmei.ml.err b/test/passing/refs.ocamlformat/break_cases-cosl_lnmp_cmei.ml.err new file mode 100644 index 0000000000..ee3b7cc5cf --- /dev/null +++ b/test/passing/refs.ocamlformat/break_cases-cosl_lnmp_cmei.ml.err @@ -0,0 +1,3 @@ +Warning: break_cases-cosl_lnmp_cmei.ml:254 exceeds the margin +Warning: break_cases-cosl_lnmp_cmei.ml:263 exceeds the margin +Warning: break_cases-cosl_lnmp_cmei.ml:275 exceeds the margin diff --git a/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.ref b/test/passing/refs.ocamlformat/break_cases-cosl_lnmp_cmei.ml.ref similarity index 96% rename from test/passing/tests/break_cases-cosl_lnmp_cmei.ml.ref rename to test/passing/refs.ocamlformat/break_cases-cosl_lnmp_cmei.ml.ref index e0a517493c..2bf848acde 100644 --- a/test/passing/tests/break_cases-cosl_lnmp_cmei.ml.ref +++ b/test/passing/refs.ocamlformat/break_cases-cosl_lnmp_cmei.ml.ref @@ -83,8 +83,7 @@ let _ = let f x y = match x with | None -> false - | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong - -> + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( match y with | Some _ -> true | None -> false @@ -269,19 +268,19 @@ let _ = let foooooooooooooo = function | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) - | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) | Foooooooooooooooo (* foooooo foooo fooooooooooo *) | Foooooooooooooo _ (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. - Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo - foooooooooooooooooo foooooooo. Foooooooooooo fooooooooooo fooooooooooooo - foooooooooooooo foooooo. *) + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) | Foooooooooo | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) | Foooo - (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo - fooo *) -> + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> Foooooooooo.Foooooo | Foooo {foooo_fooo= {foooooooooo}} -> Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo @@ -290,8 +289,8 @@ let get_nullability = function | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) | Undef - (* This is a very special case, assigning non-null is a technical - trick *) -> + (* This is a very special case, assigning non-null is a technical trick *) + -> Nullability.Nonnull let _ = diff --git a/test/passing/refs.ocamlformat/break_cases-fit_or_vertical.ml.err b/test/passing/refs.ocamlformat/break_cases-fit_or_vertical.ml.err new file mode 100644 index 0000000000..92becbfdde --- /dev/null +++ b/test/passing/refs.ocamlformat/break_cases-fit_or_vertical.ml.err @@ -0,0 +1,3 @@ +Warning: break_cases-fit_or_vertical.ml:202 exceeds the margin +Warning: break_cases-fit_or_vertical.ml:209 exceeds the margin +Warning: break_cases-fit_or_vertical.ml:220 exceeds the margin diff --git a/test/passing/tests/break_cases-fit_or_vertical.ml.ref b/test/passing/refs.ocamlformat/break_cases-fit_or_vertical.ml.ref similarity index 93% rename from test/passing/tests/break_cases-fit_or_vertical.ml.ref rename to test/passing/refs.ocamlformat/break_cases-fit_or_vertical.ml.ref index dd0c0db654..6d4ec4ba53 100644 --- a/test/passing/tests/break_cases-fit_or_vertical.ml.ref +++ b/test/passing/refs.ocamlformat/break_cases-fit_or_vertical.ml.ref @@ -1,6 +1,5 @@ let f x = function - | C | P (this, test, [is; wide; enough; _to; break], [the; line]) | A | K - -> 1 + | C | P (this, test, [is; wide; enough; _to; break], [the; line]) | A | K -> 1 | D -> let a = "this" in let b = "breaks" in @@ -63,8 +62,7 @@ let _ = let f x y = match x with | None -> false - | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong - -> ( + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( match y with | Some _ -> true | None -> false ) @@ -215,28 +213,27 @@ let _ = let foooooooooooooo = function | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) - | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) | Foooooooooooooooo (* foooooo foooo fooooooooooo *) | Foooooooooooooo _ (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. - Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo - foooooooooooooooooo foooooooo. Foooooooooooo fooooooooooo fooooooooooooo - foooooooooooooo foooooo. *) + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) | Foooooooooo | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) | Foooo - (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo - fooo *) -> Foooooooooo.Foooooo + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> Foooooooooo.Foooooo | Foooo {foooo_fooo= {foooooooooo}} -> Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo let get_nullability = function - | ArrayAccess - | OptimisticFallback (* non-null is the most optimistic type *) + | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) | Undef - (* This is a very special case, assigning non-null is a technical - trick *) -> Nullability.Nonnull + (* This is a very special case, assigning non-null is a technical trick *) + -> Nullability.Nonnull let _ = try () diff --git a/test/passing/refs.ocamlformat/break_cases-nested.ml.err b/test/passing/refs.ocamlformat/break_cases-nested.ml.err new file mode 100644 index 0000000000..efa628f646 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_cases-nested.ml.err @@ -0,0 +1,3 @@ +Warning: break_cases-nested.ml:204 exceeds the margin +Warning: break_cases-nested.ml:213 exceeds the margin +Warning: break_cases-nested.ml:225 exceeds the margin diff --git a/test/passing/tests/break_cases-nested.ml.ref b/test/passing/refs.ocamlformat/break_cases-nested.ml.ref similarity index 95% rename from test/passing/tests/break_cases-nested.ml.ref rename to test/passing/refs.ocamlformat/break_cases-nested.ml.ref index 7841f9daad..0c337ef0fd 100644 --- a/test/passing/tests/break_cases-nested.ml.ref +++ b/test/passing/refs.ocamlformat/break_cases-nested.ml.ref @@ -1,6 +1,5 @@ let f x = function - | C | P (this, test, [is; wide; enough; _to; break], [the; line]) | A | K - -> + | C | P (this, test, [is; wide; enough; _to; break], [the; line]) | A | K -> 1 | D -> let a = "this" in @@ -62,8 +61,7 @@ let _ = match x with | None -> false - | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong - -> ( + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( match y with Some _ -> true | None -> false ) in () @@ -220,19 +218,19 @@ let _ = let foooooooooooooo = function | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) - | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) | Foooooooooooooooo (* foooooo foooo fooooooooooo *) | Foooooooooooooo _ (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. - Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo - foooooooooooooooooo foooooooo. Foooooooooooo fooooooooooo fooooooooooooo - foooooooooooooo foooooo. *) + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) | Foooooooooo | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) | Foooo - (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo - fooo *) -> + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> Foooooooooo.Foooooo | Foooo {foooo_fooo= {foooooooooo}} -> Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo @@ -241,8 +239,8 @@ let get_nullability = function | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) | Undef - (* This is a very special case, assigning non-null is a technical - trick *) -> + (* This is a very special case, assigning non-null is a technical trick *) + -> Nullability.Nonnull let _ = try () with _ -> ( match () with _ -> () ) diff --git a/test/passing/refs.ocamlformat/break_cases-normal_indent.ml.err b/test/passing/refs.ocamlformat/break_cases-normal_indent.ml.err new file mode 100644 index 0000000000..17a834cbd1 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_cases-normal_indent.ml.err @@ -0,0 +1,3 @@ +Warning: break_cases-normal_indent.ml:241 exceeds the margin +Warning: break_cases-normal_indent.ml:249 exceeds the margin +Warning: break_cases-normal_indent.ml:260 exceeds the margin diff --git a/test/passing/tests/break_cases-normal_indent.ml.ref b/test/passing/refs.ocamlformat/break_cases-normal_indent.ml.ref similarity index 96% rename from test/passing/tests/break_cases-normal_indent.ml.ref rename to test/passing/refs.ocamlformat/break_cases-normal_indent.ml.ref index 3517713924..82e1a24581 100644 --- a/test/passing/tests/break_cases-normal_indent.ml.ref +++ b/test/passing/refs.ocamlformat/break_cases-normal_indent.ml.ref @@ -75,8 +75,7 @@ let _ = let f x y = match x with | None -> false - | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong - -> ( + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( match y with | Some _ -> true | None -> false ) @@ -254,19 +253,19 @@ let _ = let foooooooooooooo = function | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) - | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) | Foooooooooooooooo (* foooooo foooo fooooooooooo *) | Foooooooooooooo _ (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. - Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo - foooooooooooooooooo foooooooo. Foooooooooooo fooooooooooo fooooooooooooo - foooooooooooooo foooooo. *) + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) | Foooooooooo | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) | Foooo - (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo - fooo *) -> + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> Foooooooooo.Foooooo | Foooo {foooo_fooo= {foooooooooo}} -> Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo @@ -275,8 +274,8 @@ let get_nullability = function | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) | Undef - (* This is a very special case, assigning non-null is a technical - trick *) -> + (* This is a very special case, assigning non-null is a technical trick *) + -> Nullability.Nonnull let _ = diff --git a/test/passing/refs.ocamlformat/break_cases-toplevel.ml.err b/test/passing/refs.ocamlformat/break_cases-toplevel.ml.err new file mode 100644 index 0000000000..9df810126e --- /dev/null +++ b/test/passing/refs.ocamlformat/break_cases-toplevel.ml.err @@ -0,0 +1,3 @@ +Warning: break_cases-toplevel.ml:205 exceeds the margin +Warning: break_cases-toplevel.ml:213 exceeds the margin +Warning: break_cases-toplevel.ml:224 exceeds the margin diff --git a/test/passing/tests/break_cases-toplevel.ml.ref b/test/passing/refs.ocamlformat/break_cases-toplevel.ml.ref similarity index 93% rename from test/passing/tests/break_cases-toplevel.ml.ref rename to test/passing/refs.ocamlformat/break_cases-toplevel.ml.ref index 06ecd27dfa..9956d35d72 100644 --- a/test/passing/tests/break_cases-toplevel.ml.ref +++ b/test/passing/refs.ocamlformat/break_cases-toplevel.ml.ref @@ -1,7 +1,5 @@ let f x = function - | C | P (this, test, [is; wide; enough; _to; break], [the; line]) | A | K - -> - 1 + | C | P (this, test, [is; wide; enough; _to; break], [the; line]) | A | K -> 1 | D -> let a = "this" in let b = "breaks" in @@ -66,8 +64,7 @@ let _ = let f x y = match x with | None -> false - | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong - -> ( + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( match y with | Some _ -> true | None -> false ) @@ -220,29 +217,27 @@ let _ = let foooooooooooooo = function | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) - | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) | Foooooooooooooooo (* foooooo foooo fooooooooooo *) | Foooooooooooooo _ (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. - Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo - foooooooooooooooooo foooooooo. Foooooooooooo fooooooooooo fooooooooooooo - foooooooooooooo foooooo. *) - | Foooooooooo - | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) | Foooo - (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo - fooo *) -> + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> Foooooooooo.Foooooo | Foooo {foooo_fooo= {foooooooooo}} -> Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo let get_nullability = function - | ArrayAccess - | OptimisticFallback (* non-null is the most optimistic type *) + | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) | Undef - (* This is a very special case, assigning non-null is a technical - trick *) -> + (* This is a very special case, assigning non-null is a technical trick *) + -> Nullability.Nonnull let _ = diff --git a/test/passing/refs.ocamlformat/break_cases-vertical.ml.err b/test/passing/refs.ocamlformat/break_cases-vertical.ml.err new file mode 100644 index 0000000000..b4493f54a1 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_cases-vertical.ml.err @@ -0,0 +1,3 @@ +Warning: break_cases-vertical.ml:272 exceeds the margin +Warning: break_cases-vertical.ml:280 exceeds the margin +Warning: break_cases-vertical.ml:292 exceeds the margin diff --git a/test/passing/tests/break_cases-vertical.ml.ref b/test/passing/refs.ocamlformat/break_cases-vertical.ml.ref similarity index 96% rename from test/passing/tests/break_cases-vertical.ml.ref rename to test/passing/refs.ocamlformat/break_cases-vertical.ml.ref index 9b1d97eb0f..31c8a1ced4 100644 --- a/test/passing/tests/break_cases-vertical.ml.ref +++ b/test/passing/refs.ocamlformat/break_cases-vertical.ml.ref @@ -89,8 +89,7 @@ let _ = match x with | None -> false - | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong - -> ( + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( match y with | Some _ -> true @@ -286,19 +285,19 @@ let _ = let foooooooooooooo = function | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) - | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) | Foooooooooooooooo (* foooooo foooo fooooooooooo *) | Foooooooooooooo _ (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. - Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo - foooooooooooooooooo foooooooo. Foooooooooooo fooooooooooo fooooooooooooo - foooooooooooooo foooooo. *) + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) | Foooooooooo | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) | Foooo - (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo - fooo *) -> + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> Foooooooooo.Foooooo | Foooo {foooo_fooo= {foooooooooo}} -> Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo @@ -307,8 +306,8 @@ let get_nullability = function | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) | Undef - (* This is a very special case, assigning non-null is a technical - trick *) -> + (* This is a very special case, assigning non-null is a technical trick *) + -> Nullability.Nonnull let _ = diff --git a/test/passing/refs.ocamlformat/break_cases.ml.err b/test/passing/refs.ocamlformat/break_cases.ml.err new file mode 100644 index 0000000000..2ab6458db7 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_cases.ml.err @@ -0,0 +1,3 @@ +Warning: break_cases.ml:177 exceeds the margin +Warning: break_cases.ml:185 exceeds the margin +Warning: break_cases.ml:196 exceeds the margin diff --git a/test/passing/tests/break_cases.ml.ref b/test/passing/refs.ocamlformat/break_cases.ml.ref similarity index 93% rename from test/passing/tests/break_cases.ml.ref rename to test/passing/refs.ocamlformat/break_cases.ml.ref index 79096f350c..b1c9546828 100644 --- a/test/passing/tests/break_cases.ml.ref +++ b/test/passing/refs.ocamlformat/break_cases.ml.ref @@ -1,7 +1,5 @@ let f x = function - | C | P (this, test, [is; wide; enough; _to; break], [the; line]) | A | K - -> - 1 + | C | P (this, test, [is; wide; enough; _to; break], [the; line]) | A | K -> 1 | D -> let a = "this" in let b = "breaks" in @@ -54,8 +52,7 @@ let _ = let f x y = match x with | None -> false - | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong - -> ( + | Some looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( match y with Some _ -> true | None -> false ) in () @@ -192,29 +189,27 @@ let _ = let foooooooooooooo = function | Fooo (* fooooo foo foo foooooo foooooooo foooooooooooo *) - | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) + | Foo (* foooooo foooo fooooo fooooooo fooooooo fooooo *) | Foooooooooooooooo (* foooooo foooo fooooooooooo *) | Foooooooooooooo _ (* Foooooooooooooooooooooooooooo fooooooooooooooooooooooooooo fooooooooo. Foooooooooooooooooooooooooooooooooooo foooooooooooooooooooooooo foooooo. - Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo - foooooooooooooooooo foooooooo. Foooooooooooo fooooooooooo fooooooooooooo - foooooooooooooo foooooo. *) - | Foooooooooo - | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) + Foooooooooooooooooooooooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo foooooooo. + Foooooooooooo fooooooooooo fooooooooooooo foooooooooooooo foooooo. + *) + | Foooooooooo | FooooFoooooFoooooo (* fooooooooooooooooooooooooooooooooooo *) | Foooo - (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo - fooo *) -> + (* Fooo foooo fooooo foooooooo fooooooooo foooooooooooo fooooooooo fooo *) + -> Foooooooooo.Foooooo | Foooo {foooo_fooo= {foooooooooo}} -> Foooo_Foooo_fooooooo.get_foooooooooo fooooo_fooo let get_nullability = function - | ArrayAccess - | OptimisticFallback (* non-null is the most optimistic type *) + | ArrayAccess | OptimisticFallback (* non-null is the most optimistic type *) | Undef - (* This is a very special case, assigning non-null is a technical - trick *) -> + (* This is a very special case, assigning non-null is a technical trick *) + -> Nullability.Nonnull let _ = try () with _ -> ( match () with _ -> () ) diff --git a/test/passing/refs.ocamlformat/break_collection_expressions-wrap.ml.err b/test/passing/refs.ocamlformat/break_collection_expressions-wrap.ml.err new file mode 100644 index 0000000000..463a17c379 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_collection_expressions-wrap.ml.err @@ -0,0 +1 @@ +Warning: break_collection_expressions-wrap.ml:34 exceeds the margin diff --git a/test/passing/tests/break_collection_expressions-wrap.ml.ref b/test/passing/refs.ocamlformat/break_collection_expressions-wrap.ml.ref similarity index 68% rename from test/passing/tests/break_collection_expressions-wrap.ml.ref rename to test/passing/refs.ocamlformat/break_collection_expressions-wrap.ml.ref index 4e2214de71..c91d66d7b0 100644 --- a/test/passing/tests/break_collection_expressions-wrap.ml.ref +++ b/test/passing/refs.ocamlformat/break_collection_expressions-wrap.ml.ref @@ -32,26 +32,24 @@ let length = [@foo] let length = - [ 0; 14; (* foo *) 14; 17 (* foo *); 17; 2777777777777777777777777777777777 - ; 27 ] + [0; 14; (* foo *) 14; 17 (* foo *); 17; 2777777777777777777777777777777777; 27] [@foo] let length = - [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 8; 9; 9; 10; 10; 11; 11; 12; 12; 12; 12; 13 - ; 25; 25; 25; 25; 25; 25; 25; 25; 25; 26; 26; 26; 26; 26; 26; 26; 26; 26 - ; 26; 26; 26; 26; 26; 26 - ; 269999999999999999999999999999999999999999999999999; 26; 26; 26; 26; 26 - ; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 27; 27; 27; 27; 27; 27; 27 - ; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27 + [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 8; 9; 9; 10; 10; 11; 11; 12; 12; 12; 12; 13; 25 + ; 25; 25; 25; 25; 25; 25; 25; 25; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26 + ; 26; 26; 26; 26; 269999999999999999999999999999999999999999999999999; 26; 26 + ; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 26; 27; 27; 27; 27; 27 + ; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27 ; (* foo *) 27 (* foo *); 27; 27; 27; 27; 27; 27; 27; 27; 27; 28 |] [@foo] let length = [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 8; 9; 9; 10; 10; 11; 11; 12; 12; 12; 12; 13; 13 - ; 13; 13; 14; 14; 14; (* foo *) 14; 15; 15; 15; 15; 16; 16; 16; 16; 16; 16 - ; 16; 16; 17; 17; 17; 17 (* foo *); 17; 17; 17; 17; 18; 18; 18; 18; 18; 18 - ; 18; 18; 19; 19; 19; 19; 19; 19; 19; 19; 20; 20; 20; 20; 20; 20; 20; 20 - ; 20; 20; 20; 26; 26; 26; 26; 26; 27; 27; 27; 27 - ; 2777777777777777777777777777777777; 27; 27; 27; 27; 27; 27; 27; 27; 27 - ; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 28 ] + ; 13; 13; 14; 14; 14; (* foo *) 14; 15; 15; 15; 15; 16; 16; 16; 16; 16; 16; 16 + ; 16; 17; 17; 17; 17 (* foo *); 17; 17; 17; 17; 18; 18; 18; 18; 18; 18; 18; 18 + ; 19; 19; 19; 19; 19; 19; 19; 19; 20; 20; 20; 20; 20; 20; 20; 20; 20; 20; 20 + ; 26; 26; 26; 26; 26; 27; 27; 27; 27; 2777777777777777777777777777777777; 27 + ; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27; 27 + ; 27; 27; 27; 27; 27; 27; 28 ] [@foo] diff --git a/test/passing/refs.ocamlformat/break_collection_expressions.ml.err b/test/passing/refs.ocamlformat/break_collection_expressions.ml.err new file mode 100644 index 0000000000..0f7f8bac77 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_collection_expressions.ml.err @@ -0,0 +1 @@ +Warning: break_collection_expressions.ml:42 exceeds the margin diff --git a/test/passing/tests/break_collection_expressions.ml.ref b/test/passing/refs.ocamlformat/break_collection_expressions.ml.ref similarity index 96% rename from test/passing/tests/break_collection_expressions.ml.ref rename to test/passing/refs.ocamlformat/break_collection_expressions.ml.ref index 36d0755569..ff74b00679 100644 --- a/test/passing/tests/break_collection_expressions.ml.ref +++ b/test/passing/refs.ocamlformat/break_collection_expressions.ml.ref @@ -40,14 +40,7 @@ let length = [@foo] let length = - [ 0 - ; 14 - ; (* foo *) - 14 - ; 17 (* foo *) - ; 17 - ; 2777777777777777777777777777777777 - ; 27 ] + [0; 14; (* foo *) 14; 17 (* foo *); 17; 2777777777777777777777777777777777; 27] [@foo] let length = diff --git a/test/passing/tests/break_colon-before.ml.ref b/test/passing/refs.ocamlformat/break_colon-before.ml.ref similarity index 94% rename from test/passing/tests/break_colon-before.ml.ref rename to test/passing/refs.ocamlformat/break_colon-before.ml.ref index 73278765a3..2fb727bdc5 100644 --- a/test/passing/tests/break_colon-before.ml.ref +++ b/test/passing/refs.ocamlformat/break_colon-before.ml.ref @@ -19,8 +19,7 @@ module type M = sig : (Location.t -> Env.t -> Longident.t -> Path.t) ref val imported_sets_of_closures_table - : Simple_value_approx.function_declarations option - Set_of_closures_id.Tbl.t + : Simple_value_approx.function_declarations option Set_of_closures_id.Tbl.t type 'a option_decl = names:string list @@ -47,7 +46,7 @@ module type M = sig val f : x:t (** an extremely long comment about [x] that does not fit on the - same line with [x] *) + same line with [x] *) -> unit val f @@ -58,7 +57,7 @@ module type M = sig -> foooooooooooooo * fooooooooooooooooo -> foooooooooooooooo ) (** an extremely long comment about [x] that does not fit on the - same line with [x] *) + same line with [x] *) -> unit end diff --git a/test/passing/refs.ocamlformat/break_colon.ml.ref b/test/passing/refs.ocamlformat/break_colon.ml.ref new file mode 100644 index 0000000000..198d231b97 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_colon.ml.ref @@ -0,0 +1,92 @@ +(* Bad: unboxing the function type *) +external i : (int -> float[@unboxed]) = "i" "i_nat" + +module type M = sig + val action : action + (** Formatting action: input type and source, and output destination. *) + + val doc_atrs : + (string Location.loc * payload) list + -> (string Location.loc * bool) list option + * (string Location.loc * payload) list + + val transl_modtype_longident (* from Typemod *) : + (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val transl_modtype_longident + (* foooooooooo fooooooooooooo foooooooooooo foooooooooooooo + foooooooooooooo foooooooooooo *) : + (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val imported_sets_of_closures_table : + Simple_value_approx.function_declarations option Set_of_closures_id.Tbl.t + + type 'a option_decl = + names:string list + -> doc:string + -> section:[`Formatting | `Operational] + -> ?allow_inline:bool + -> (config -> 'a -> config) + -> (config -> 'a) + -> 'a t + + val select : + (* The fsevents context *) + env + -> (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list + -> (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list + -> (* Timeout...like Unix.select *) + timeout:float + -> (* The callback for file system events *) + (event list -> unit) + -> unit + + val f : + x:t + (** an extremely long comment about [x] that does not fit on the + same line with [x] *) + -> unit + + val f : + fooooooooooooooooo: + ( fooooooooooooooo + -> fooooooooooooooooooo + -> foooooooooooooo + -> foooooooooooooo * fooooooooooooooooo + -> foooooooooooooooo ) + (** an extremely long comment about [x] that does not fit on the + same line with [x] *) + -> unit +end + +let ssmap : + (module MapT + with type key = string + and type data = string + and type map = SSMap.map ) = + () + +let ssmap : + (module MapT + with type key = string + and type data = string + and type map = SSMap.map ) + -> unit = + () + +let long_function_name : type a. + a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit = + fun () -> () + +let array_fold_transf (f : numbering -> 'a -> numbering * 'b) n (a : 'a array) : + numbering * 'b array = + match Array.length a with 0 -> (n, [||]) | 1 -> x + +let to_clambda_function (id, (function_decl : Flambda.function_declaration)) : + Clambda.ufunction = + (* All that we need in the environment, for translating one closure from a + closed set of closures, is the substitutions for variables bound to the + various closures in the set. Such closures will always be ... *) + x diff --git a/test/passing/tests/break_fun_decl-fit_or_vertical.ml.ref b/test/passing/refs.ocamlformat/break_fun_decl-fit_or_vertical.ml.ref similarity index 96% rename from test/passing/tests/break_fun_decl-fit_or_vertical.ml.ref rename to test/passing/refs.ocamlformat/break_fun_decl-fit_or_vertical.ml.ref index 74c628a8c3..86f021f558 100644 --- a/test/passing/tests/break_fun_decl-fit_or_vertical.ml.ref +++ b/test/passing/refs.ocamlformat/break_fun_decl-fit_or_vertical.ml.ref @@ -53,13 +53,10 @@ class ffffffffffffffffffff cccccccccccccccccccccc dddddddddddddddddddddd = g -let ffffffffffffffffffff : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb = - g +let ffffffffffffffffffff : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb = g let ffffffffffffffffffff : - aaaaaaaaaaaaaaaaaaaaaa - -> bbbbbbbbbbbbbbbbbbbbbb - -> cccccccccccccccccccccc = + aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb -> cccccccccccccccccccccc = g let ffffffffffffffffffff : diff --git a/test/passing/tests/break_fun_decl-smart.ml.ref b/test/passing/refs.ocamlformat/break_fun_decl-smart.ml.ref similarity index 96% rename from test/passing/tests/break_fun_decl-smart.ml.ref rename to test/passing/refs.ocamlformat/break_fun_decl-smart.ml.ref index 9aa19ddd4e..372bc54ea2 100644 --- a/test/passing/tests/break_fun_decl-smart.ml.ref +++ b/test/passing/refs.ocamlformat/break_fun_decl-smart.ml.ref @@ -49,13 +49,10 @@ class ffffffffffffffffffff cccccccccccccccccccccc dddddddddddddddddddddd = g -let ffffffffffffffffffff : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb = - g +let ffffffffffffffffffff : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb = g let ffffffffffffffffffff : - aaaaaaaaaaaaaaaaaaaaaa - -> bbbbbbbbbbbbbbbbbbbbbb - -> cccccccccccccccccccccc = + aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb -> cccccccccccccccccccccc = g let ffffffffffffffffffff : diff --git a/test/passing/tests/break_fun_decl-wrap.ml.ref b/test/passing/refs.ocamlformat/break_fun_decl-wrap.ml.ref similarity index 96% rename from test/passing/tests/break_fun_decl-wrap.ml.ref rename to test/passing/refs.ocamlformat/break_fun_decl-wrap.ml.ref index 051e97b450..95285cdde3 100644 --- a/test/passing/tests/break_fun_decl-wrap.ml.ref +++ b/test/passing/refs.ocamlformat/break_fun_decl-wrap.ml.ref @@ -31,13 +31,10 @@ class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccc dddddddddddddddddddddd = g -let ffffffffffffffffffff : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb = - g +let ffffffffffffffffffff : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb = g let ffffffffffffffffffff : - aaaaaaaaaaaaaaaaaaaaaa - -> bbbbbbbbbbbbbbbbbbbbbb - -> cccccccccccccccccccccc = + aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb -> cccccccccccccccccccccc = g let ffffffffffffffffffff : diff --git a/test/passing/refs.ocamlformat/break_fun_decl.ml.ref b/test/passing/refs.ocamlformat/break_fun_decl.ml.ref new file mode 100644 index 0000000000..95285cdde3 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_fun_decl.ml.ref @@ -0,0 +1,124 @@ +class t = + object + method meth aaaaaaaaaaa bbbbbbbbbbbbbb ccccccccccccccccccc + ddddddddddddddddddddd eeeeeeeeeeeeeee = + body + end + +let func aaaaaaaaaaa bbbbbbbbbbbbbb ccccccccccccccccccc ddddddddddddddddddddd + eeeeeeeeeeeeeee = + body + +let rec func aaaaaaaaaaa bbbbbbbbbbbbbb ccccccccccccccccccc + ddddddddddddddddddddd eeeeeeeeeeeeeee = + body + +let ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc = + g + +let ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc dddddddddddddddddddddd = + g + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb = g + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc = g + +class ffffffffffffffffffff aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccc dddddddddddddddddddddd = g + +let ffffffffffffffffffff : aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb = g + +let ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa -> bbbbbbbbbbbbbbbbbbbbbb -> cccccccccccccccccccccc = + g + +let ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd = + g + +let fffffffffffffffffffffffffffffffffff x yyyyyyyyyyyyyyyyyyyyyyyyyyy = () + +let fffffffffffffffffffffffffffffffffff x yyyyyyyyyyyyyyyyyyyyyyyyyyy + yyyyyyyyyyyyyyyyyyyyyyyyyyy = + () + +class ffffffffffffffffffff = + object + method ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd = + g + + val ffffffffffffffffffff + : aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd = + g + end + +class type ffffffffffffffffffff = object + method ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd + + val ffffffffffffffffffff : + aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd + + val ffffffffffffffffffff : + ( aaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd ) + -> bbbbbbbbbbbbbbbbbbbbbb + -> cccccccccccccccccccccc + -> dddddddddddddddddddddd +end + +let _ = + fun (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) -> + body + +let _ = + f + (fun + (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) + -> body ) + +let f (module Store : Irmin.Generic_key.S with type repo = repo) + (module Store : Irmin.Generic_key.S with type repo = repo) = + body + +(* Inconsistent formatting of fun arguments. *) + +let new_specialised_args = + Variable.Map.mapi + (fun new_inner_var______ (definition : Definition.t) : + Flambda.specialised_to -> () ) + foo + +let new_specialised_args = + Variable.Map.mapi + (fun + new_inner_var______ + (definition : Definition.t) + : + Flambda.specialised_to + -> () ) diff --git a/test/passing/refs.ocamlformat/break_infix-fit-or-vertical.ml.err b/test/passing/refs.ocamlformat/break_infix-fit-or-vertical.ml.err new file mode 100644 index 0000000000..7a5a6543fb --- /dev/null +++ b/test/passing/refs.ocamlformat/break_infix-fit-or-vertical.ml.err @@ -0,0 +1 @@ +Warning: break_infix-fit-or-vertical.ml:54 exceeds the margin diff --git a/test/passing/tests/break_infix-fit-or-vertical.ml.ref b/test/passing/refs.ocamlformat/break_infix-fit-or-vertical.ml.ref similarity index 96% rename from test/passing/tests/break_infix-fit-or-vertical.ml.ref rename to test/passing/refs.ocamlformat/break_infix-fit-or-vertical.ml.ref index 7aa7824b43..e3f9c77ebc 100644 --- a/test/passing/tests/break_infix-fit-or-vertical.ml.ref +++ b/test/passing/refs.ocamlformat/break_infix-fit-or-vertical.ml.ref @@ -52,8 +52,7 @@ let pf0 = |> seal let cmd = - root - ^ ("_build" / "default" / Fmt.str "%s serve %d %d &" Sys.argv.(0) i id.id) + root ^ ("_build" / "default" / Fmt.str "%s serve %d %d &" Sys.argv.(0) i id.id) let _ = a b c diff --git a/test/passing/refs.ocamlformat/break_infix-wrap.ml.err b/test/passing/refs.ocamlformat/break_infix-wrap.ml.err new file mode 100644 index 0000000000..447de828f8 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_infix-wrap.ml.err @@ -0,0 +1 @@ +Warning: break_infix-wrap.ml:33 exceeds the margin diff --git a/test/passing/tests/break_infix-wrap.ml.ref b/test/passing/refs.ocamlformat/break_infix-wrap.ml.ref similarity index 95% rename from test/passing/tests/break_infix-wrap.ml.ref rename to test/passing/refs.ocamlformat/break_infix-wrap.ml.ref index 3b2545994f..bda05b2f65 100644 --- a/test/passing/tests/break_infix-wrap.ml.ref +++ b/test/passing/refs.ocamlformat/break_infix-wrap.ml.ref @@ -31,8 +31,7 @@ let pf0 = |+ disk_folder |> seal let cmd = - root - ^ ("_build" / "default" / Fmt.str "%s serve %d %d &" Sys.argv.(0) i id.id) + root ^ ("_build" / "default" / Fmt.str "%s serve %d %d &" Sys.argv.(0) i id.id) let _ = a b c :: fooo fooooooooo fooo :: x y zzzzzzz @@ -51,8 +50,8 @@ let _ = let _ = a + (b * c) + d let _ = - a + (b * c) + d + (b * c) + d + (b * c) + d + (b * c) + d + (b * c) - + (b * c) + (b * c) + a + (b * c) + d + (b * c) + d + (b * c) + d + (b * c) + d + (b * c) + (b * c) + + (b * c) (* Break infix if followed by let or letop *) diff --git a/test/passing/refs.ocamlformat/break_infix.ml.err b/test/passing/refs.ocamlformat/break_infix.ml.err new file mode 100644 index 0000000000..638da996cc --- /dev/null +++ b/test/passing/refs.ocamlformat/break_infix.ml.err @@ -0,0 +1 @@ +Warning: break_infix.ml:48 exceeds the margin diff --git a/test/passing/tests/break_infix.ml.ref b/test/passing/refs.ocamlformat/break_infix.ml.ref similarity index 96% rename from test/passing/tests/break_infix.ml.ref rename to test/passing/refs.ocamlformat/break_infix.ml.ref index 71a79f5806..b2b5fc122e 100644 --- a/test/passing/tests/break_infix.ml.ref +++ b/test/passing/refs.ocamlformat/break_infix.ml.ref @@ -46,8 +46,7 @@ let pf0 = |> seal let cmd = - root - ^ ("_build" / "default" / Fmt.str "%s serve %d %d &" Sys.argv.(0) i id.id) + root ^ ("_build" / "default" / Fmt.str "%s serve %d %d &" Sys.argv.(0) i id.id) let _ = a b c diff --git a/test/passing/refs.ocamlformat/break_record.ml.ref b/test/passing/refs.ocamlformat/break_record.ml.ref new file mode 100644 index 0000000000..136f4038c8 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_record.ml.ref @@ -0,0 +1,2 @@ +let xxxxxxxxxxxxxxxxxxxxxx x = + {xxxxxxxxxxxxxx; xxxxxxxxxxxxxxxxxx= x; xxxxxxxxxxxxx} diff --git a/test/passing/refs.ocamlformat/break_separators-after.ml.err b/test/passing/refs.ocamlformat/break_separators-after.ml.err new file mode 100644 index 0000000000..6476999ed0 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_separators-after.ml.err @@ -0,0 +1 @@ +Warning: break_separators-after.ml:150 exceeds the margin diff --git a/test/passing/tests/break_separators-after.ml.ref b/test/passing/refs.ocamlformat/break_separators-after.ml.ref similarity index 95% rename from test/passing/tests/break_separators-after.ml.ref rename to test/passing/refs.ocamlformat/break_separators-after.ml.ref index cecce25ed2..389772c611 100644 --- a/test/passing/tests/break_separators-after.ml.ref +++ b/test/passing/refs.ocamlformat/break_separators-after.ml.ref @@ -71,7 +71,8 @@ let _ = another_very_very_long_field_name_running_out_of_space= 2; _ } -> 0 - | _ -> 1 + | _ -> + 1 let _ = match something with @@ -79,7 +80,8 @@ let _ = another_very_very_long_field_name_running_out_of_space; _ ] -> 0 - | _ -> 1 + | _ -> + 1 let _ = match something with @@ -87,14 +89,14 @@ let _ = another_very_very_long_field_name_running_out_of_space; _ |] -> 0 - | _ -> 1 + | _ -> + 1 [@@@ocamlformat "type-decl=compact"] type t = {aaaaaaaaa: aaaa; bbbbbbbbb: bbbb} -type trace_mod_funs = - {trace_mod: bool option; trace_funs: bool Map.M(String).t} +type trace_mod_funs = {trace_mod: bool option; trace_funs: bool Map.M(String).t} [@@@ocamlformat "type-decl=sparse"] @@ -146,14 +148,7 @@ let length = (* this is a list *) let length = - [ 0; - 14; - (* foo *) - 14; - 17 (* foo *); - 17; - 2777777777777777777777777777777777; - 27 ] + [0; 14; (* foo *) 14; 17 (* foo *); 17; 2777777777777777777777777777777777; 27] [@foo] ;; @@ -172,16 +167,12 @@ class 'yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy ] k -type ( 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, - 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb ) - a = +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = ( 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ) e -type ( 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, - 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb ) - a = +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = ('aaaaaaaaa, 'bbbbbbbbbbbb) e let ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, @@ -296,8 +287,7 @@ let fooooooooooo = function | Pmty_alias lid -> { empty with bdy= fmt_longident_loc c lid; - epi= Some (fmt_attributes c ~key:"@" pmty_attributes ~pre:(fmt "@ ")) - } + epi= Some (fmt_attributes c ~key:"@" pmty_attributes ~pre:(fmt "@ ")) } let f () = let { aaaaaaaa; diff --git a/test/passing/refs.ocamlformat/break_separators-after_docked.ml.err b/test/passing/refs.ocamlformat/break_separators-after_docked.ml.err new file mode 100644 index 0000000000..7189b3922e --- /dev/null +++ b/test/passing/refs.ocamlformat/break_separators-after_docked.ml.err @@ -0,0 +1 @@ +Warning: break_separators-after_docked.ml:170 exceeds the margin diff --git a/test/passing/tests/break_separators-after_docked.ml.ref b/test/passing/refs.ocamlformat/break_separators-after_docked.ml.ref similarity index 94% rename from test/passing/tests/break_separators-after_docked.ml.ref rename to test/passing/refs.ocamlformat/break_separators-after_docked.ml.ref index 14d8e5dfe6..2475911b91 100644 --- a/test/passing/tests/break_separators-after_docked.ml.ref +++ b/test/passing/refs.ocamlformat/break_separators-after_docked.ml.ref @@ -54,8 +54,8 @@ type t = { let_open: [`Preserve | `Auto | `Short | `Long]; margin: int; (** Format code to fit within [margin] columns. *) max_iters: int; - (** Fail if output of formatting does not stabilize within [max_iters] - iterations. *) + (** Fail if output of formatting does not stabilize within + [max_iters] iterations. *) module_item_spacing: [`Compact | `Sparse]; ocp_indent_compat: bool; (** Try to indent like ocp-indent *) parens_ite: bool; @@ -78,7 +78,8 @@ let _ = _; } -> 0 - | _ -> 1 + | _ -> + 1 let _ = match something with @@ -88,7 +89,8 @@ let _ = _; ] -> 0 - | _ -> 1 + | _ -> + 1 let _ = match something with @@ -98,16 +100,14 @@ let _ = _; |] -> 0 - | _ -> 1 + | _ -> + 1 [@@@ocamlformat "type-decl=compact"] type t = {aaaaaaaaa: aaaa; bbbbbbbbb: bbbb} -type trace_mod_funs = { - trace_mod: bool option; - trace_funs: bool Map.M(String).t; -} +type trace_mod_funs = {trace_mod: bool option; trace_funs: bool Map.M(String).t} [@@@ocamlformat "type-decl=sparse"] @@ -168,14 +168,7 @@ let length = (* this is a list *) let length = [ - 0; - 14; - (* foo *) - 14; - 17 (* foo *); - 17; - 2777777777777777777777777777777777; - 27; + 0; 14; (* foo *) 14; 17 (* foo *); 17; 2777777777777777777777777777777777; 27; ] [@foo] ;; @@ -197,16 +190,12 @@ class 'yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy ] k -type ( 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, - 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb ) - a = +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = ( 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ) e -type ( 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, - 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb ) - a = +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = ('aaaaaaaaa, 'bbbbbbbbbbbb) e let ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, @@ -257,7 +246,7 @@ type t = { (* fooooooooooooooooo *) foo: foo; (* foooooooooooooooooooooo fooooooooooooooooooo fooooooooooooooo - foooooooooooooooooo foooooooooooooooo *) + foooooooooooooooooo foooooooooooooooo *) foo: (* fooooooooooooooooooo *) foooooooooooo -> diff --git a/test/passing/refs.ocamlformat/break_separators-before_docked.ml.err b/test/passing/refs.ocamlformat/break_separators-before_docked.ml.err new file mode 100644 index 0000000000..dc41463adb --- /dev/null +++ b/test/passing/refs.ocamlformat/break_separators-before_docked.ml.err @@ -0,0 +1 @@ +Warning: break_separators-before_docked.ml:170 exceeds the margin diff --git a/test/passing/tests/break_separators-before_docked.ml.ref b/test/passing/refs.ocamlformat/break_separators-before_docked.ml.ref similarity index 95% rename from test/passing/tests/break_separators-before_docked.ml.ref rename to test/passing/refs.ocamlformat/break_separators-before_docked.ml.ref index 770ad97474..ef462361b2 100644 --- a/test/passing/tests/break_separators-before_docked.ml.ref +++ b/test/passing/refs.ocamlformat/break_separators-before_docked.ml.ref @@ -78,7 +78,8 @@ let _ = ; _ } -> 0 - | _ -> 1 + | _ -> + 1 let _ = match something with @@ -88,7 +89,8 @@ let _ = ; _ ] -> 0 - | _ -> 1 + | _ -> + 1 let _ = match something with @@ -98,16 +100,14 @@ let _ = ; _ |] -> 0 - | _ -> 1 + | _ -> + 1 [@@@ocamlformat "type-decl=compact"] type t = {aaaaaaaaa: aaaa; bbbbbbbbb: bbbb} -type trace_mod_funs = { - trace_mod: bool option - ; trace_funs: bool Map.M(String).t -} +type trace_mod_funs = {trace_mod: bool option; trace_funs: bool Map.M(String).t} [@@@ocamlformat "type-decl=sparse"] @@ -168,14 +168,7 @@ let length = (* this is a list *) let length = [ - 0 - ; 14 - ; (* foo *) - 14 - ; 17 (* foo *) - ; 17 - ; 2777777777777777777777777777777777 - ; 27 + 0; 14; (* foo *) 14; 17 (* foo *); 17; 2777777777777777777777777777777777; 27 ] [@foo] ;; @@ -197,16 +190,12 @@ class , 'yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy ] k -type ( 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa - , 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb ) - a = +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = ( 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa , 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ) e -type ( 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa - , 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb ) - a = +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = ('aaaaaaaaa, 'bbbbbbbbbbbb) e let ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx diff --git a/test/passing/refs.ocamlformat/break_separators.ml.err b/test/passing/refs.ocamlformat/break_separators.ml.err new file mode 100644 index 0000000000..7a121d6b41 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_separators.ml.err @@ -0,0 +1 @@ +Warning: break_separators.ml:150 exceeds the margin diff --git a/test/passing/refs.ocamlformat/break_separators.ml.ref b/test/passing/refs.ocamlformat/break_separators.ml.ref new file mode 100644 index 0000000000..b1c0c013d2 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_separators.ml.ref @@ -0,0 +1,378 @@ +type t = + { (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + foooooooooooooooooooooooo: foooooooooooooooooooooooooooooooooooooooo + ; (* foooooooooooooooooooooooooooooooooooooooooooo *) + fooooooooooooooooooooooooooooo: fooooooooooooooooooooooooooo } + +type x = + | B of + { (* fooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaaaaa: aaaaaaaaaaaaaaaa + ; (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbb: bbbbbbbbbbbbbbb } + +type t = + { aaaaaaaaaaaaaaaaaaaaaaaaa: aaaa aaaaaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbbbbbbbbbbbbbb: bbbbbbbbbbbb bbbb + ; cccccccccccccccccccccc: ccccccc ccccccccccc cccccccc } + +type x = + | B of + { aaaaaaaaaaaaaaa: aaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbbbbbbbbbbbb: bbbbbbbbbbbbbbb } + +type t = + { break_cases: [`Fit | `Nested | `All] + ; break_collection_expressions: [`Wrap | `Fit_or_vertical] + ; break_infix: [`Wrap | `Fit_or_vertical] + ; break_separators: bool + ; break_sequences: bool + ; break_string_literals: [`Newlines | `Never | `Wrap] + (** How to potentially break string literals into new lines. *) + ; break_struct: bool + ; cases_exp_indent: int + ; comment_check: bool + ; disable: bool + ; doc_comments: [`Before | `After] + ; escape_chars: [`Decimal | `Hexadecimal | `Preserve] + (** Escape encoding for chars literals. *) + ; escape_strings: [`Decimal | `Hexadecimal | `Preserve] + (** Escape encoding for string literals. *) + ; extension_sugar: [`Preserve | `Always] + ; field_space: [`Tight | `Loose] + ; if_then_else: [`Compact | `Keyword_first] + ; indicate_multiline_delimiters: bool + ; indicate_nested_or_patterns: bool + ; infix_precedence: [`Indent | `Parens] + ; leading_nested_match_parens: bool + ; let_and: [`Compact | `Sparse] + ; let_binding_spacing: [`Compact | `Sparse | `Double_semicolon] + ; let_open: [`Preserve | `Auto | `Short | `Long] + ; margin: int (** Format code to fit within [margin] columns. *) + ; max_iters: int + (** Fail if output of formatting does not stabilize within + [max_iters] iterations. *) + ; module_item_spacing: [`Compact | `Sparse] + ; ocp_indent_compat: bool (** Try to indent like ocp-indent *) + ; parens_ite: bool + ; parens_tuple: [`Always | `Multi_line_only] + ; parens_tuple_patterns: [`Always | `Multi_line_only] + ; parse_docstrings: bool + ; quiet: bool + ; sequence_style: [`Separator | `Terminator] + ; single_case: [`Compact | `Sparse] + ; type_decl: [`Compact | `Sparse] + ; wrap_comments: bool (** Wrap comments at margin. *) + ; wrap_fun_args: bool } + +let _ = + match something with + | { very_very_long_field_name_running_out_of_space= 1 + ; another_very_very_long_field_name_running_out_of_space= 2 + ; _ } -> + 0 + | _ -> + 1 + +let _ = + match something with + | [ very_very_long_field_name_running_out_of_space + ; another_very_very_long_field_name_running_out_of_space + ; _ ] -> + 0 + | _ -> + 1 + +let _ = + match something with + | [| very_very_long_field_name_running_out_of_space + ; another_very_very_long_field_name_running_out_of_space + ; _ |] -> + 0 + | _ -> + 1 + +[@@@ocamlformat "type-decl=compact"] + +type t = {aaaaaaaaa: aaaa; bbbbbbbbb: bbbb} + +type trace_mod_funs = {trace_mod: bool option; trace_funs: bool Map.M(String).t} + +[@@@ocamlformat "type-decl=sparse"] + +module X = struct + val select : + (* The fsevents context *) + env + -> (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list + -> (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list + -> (* Timeout...like Unix.select *) + timeout:float + -> (* The callback for file system events *) + (event list -> unit) + -> unit +end + +type t = + { aaaaaaaaa: aaaa + ; bbbbbbbbb: bbbb } + +type trace_mod_funs = + { trace_mod: bool option + ; trace_funs: bool Map.M(String).t } + +let x {aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa} = + {aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb= bbb bb bbbbbb} + +let x + { aaaaaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaa + ; aaaaaaaaaa } = + { aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbb= bbb bb bbbbbb + ; cccccc= cccc ccccccccccccccccccccccc } + +(* this is an array *) +let length = + [| 0 + ; 269999999999999999999999999999999999999999999999999 + ; 26 + ; (* foo *) 27 (* foo *) + ; 27 + ; 27 |] + [@foo] + +(* this is a list *) +let length = + [0; 14; (* foo *) 14; 17 (* foo *); 17; 2777777777777777777777777777777777; 27] + [@foo] +;; + +Fooooooo.foo ~foooooooooooooo ~fooooooooo:"" + (Foo.foo ~foo ~foo ~foooo:() + [ ("fooooo", Foo.fooo ~foooo ~foooo:(foooo >*> fooooo)) + ; ("foooo", fooooooo) + ; ("foooooo", foooooooo) + ; ("fooooooooo", foooooooo) ] ) + +class + [ 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + , 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ] + x = + [ 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + , 'yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy ] + k + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ( 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + , 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ) + e + +type ('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbb) a = + ('aaaaaaaaa, 'bbbbbbbbbbbb) e + +let ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + , yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy + , zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + , (aaaaaaaaaaaa, bbbbbbbbbbbb) ) = + ( ( xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + , yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy + , zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz ) + , (aaaaaaaaaaaaaa, bbbbbbbbbbbb) ) + +type t = aaaaaaaaaaaa -> bbbbbbbbbbbb -> cccccccccc + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + -> ccccccccccccccccccccccccc + +type t = + (* foooooooooooo *) + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + -> (* foooooooooooooooooooooooooooooooo*) + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + -> (* fooooooooooooooooo *) + ccccccccccccccccccccccccc + -> (* foooooo *) + foo * [`Foo of foo * foo] + -> (* foooooooooooooooo *) + foo + * foo + * foo + * foo + * [ `Foo of + (* fooooooooooooooooooo *) + foo * foo * foo + -> foo + -> foo + -> (* foooooooooooo *) + foo + -> foo + -> foo * foo + -> foo * foo + -> foo * foo ] + -> (* foooooooooooooooo *) + fooooooooooooooooo + +type t = + { (* fooooooooooooooooo *) + foo: foo + ; (* foooooooooooooooooooooo fooooooooooooooooooo fooooooooooooooo + foooooooooooooooooo foooooooooooooooo *) + foo: + (* fooooooooooooooooooo *) + foooooooooooo + -> (* foooooooooooooo *) + foooooooooooooooo + -> foooooooooooooo + -> foooooooooo + -> fooooooooooooooo + ; foo: foo } + +[@@@ocamlformat "ocp-indent-compat"] + +type t = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + -> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + -> ccccccccccccccccccccccccc + +type t = + (string Location.loc * payload) list + -> (string Location.loc * bool) list option + * (string Location.loc * payload) list + -> (string Location.loc * bool) list option + * (string Location.loc * payload) list + -> (string Location.loc * bool) list option + * (string Location.loc * payload) list + +let x {aaaaaaaaaaaaaa; aaaaaaaaaaaaa; aaaaaaaaaa} = + {aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa; bbbbbbbbbbbbb= bbb bb bbbbbb} + +let x + { aaaaaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaaa + ; aaaaaaaaaaaaaa + ; aaaaaaaaaaaaaaaaaa + ; aaaaaaaaaa } + = + { aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa + ; bbbbbbbbbbbbb= bbb bb bbbbbb + ; cccccc= cccc ccccccccccccccccccccccc } + +let foooooooooooooooooooooooooooooooooo = + { (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + aaaaaaaaaaaa= aaaaaaaaaaaaaaaaa + ; (* fooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + bbbbbbbbbbbbb= bbb bb bbbbbb + ; cccccc= cccc ccccccccccccccccccccccc } + +let foooooooooooo = + { foooooooooooooo with + fooooooooooooooooooooooooooooo= fooooooooooooo + ; fooooooooooooo= foooooooooooooo } + +let foooooooooooo = + { foooooooooooooo with + (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo + *) + fooooooooooooooooooooooooooooo= fooooooooooooo + ; fooooooooooooo= foooooooooooooo } + +let fooooooooooo = function + | Pmty_alias lid -> + { empty with + bdy= fmt_longident_loc c lid + ; epi= Some (fmt_attributes c ~key:"@" pmty_attributes ~pre:(fmt "@ ")) } + +let f () = + let { aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh } + = + some_value + in + foooooooooooo + +let f () = + let [ aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh ] + = + some_value + in + foooooooooooo + +let f () = + let [| aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh |] + = + some_value + in + foooooooooooo + +let g () = + match some_value with + | { aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh } -> + foooooooo + | [ aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh ] -> + fooooooooo + | [| aaaaaaaa + ; bbbbbbbbbb + ; ccccccccc + ; dddddddddd + ; eeeeeeeee + ; ffffffffff + ; gggggggggg + ; hhhhhhhhhh |] -> + fooooooooo + +let () = + match x with + | ( _ + , (* line 1 line 2 *) + Some _ ) -> + x + +let () = + match x with + | ( _ + , (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1 + veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 + *) + Some _ ) -> + x diff --git a/test/passing/refs.ocamlformat/break_sequence_before.ml.ref b/test/passing/refs.ocamlformat/break_sequence_before.ml.ref new file mode 100644 index 0000000000..4c49ff9215 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_sequence_before.ml.ref @@ -0,0 +1,47 @@ +[@@@ocamlformat "sequence-style=before"] + +let foo x y = + lazy + ( fooooooooooooooooooooooo + ; fooooooooooooooooooooooo + ;%ext + foooooooooooooooooooooooooo + ; fooooooooooooooooooooooooo ) + +let _ = + do_ + ;%ext + job_1 + ; job_2 + ; job_1 + ; job_2 + ; job_1 + ;%ext + job_2 + ; job_1 + ; job_2 + ; job_1 + ; job_2 + ; return () + +let _ = + do_ + ; job_1 + ; job_2 + ;%ext + f + ( job_1 + ; job_2 + ; job_1 + ; job_2 + ; job_1 + ;%ext + job_2 + ;%ext + job_2 + ; job_1 + ; job_2 + ; job_1 + ; job_2 ) + ;%ext + return () diff --git a/test/passing/refs.ocamlformat/break_string_literals-never.ml.err b/test/passing/refs.ocamlformat/break_string_literals-never.ml.err new file mode 100644 index 0000000000..72fe0a9080 --- /dev/null +++ b/test/passing/refs.ocamlformat/break_string_literals-never.ml.err @@ -0,0 +1,6 @@ +Warning: break_string_literals-never.ml:3 exceeds the margin +Warning: break_string_literals-never.ml:6 exceeds the margin +Warning: break_string_literals-never.ml:47 exceeds the margin +Warning: break_string_literals-never.ml:50 exceeds the margin +Warning: break_string_literals-never.ml:62 exceeds the margin +Warning: break_string_literals-never.ml:67 exceeds the margin diff --git a/test/passing/tests/break_string_literals-never.ml.ref b/test/passing/refs.ocamlformat/break_string_literals-never.ml.ref similarity index 100% rename from test/passing/tests/break_string_literals-never.ml.ref rename to test/passing/refs.ocamlformat/break_string_literals-never.ml.ref diff --git a/test/passing/tests/break_string_literals.ml.ref b/test/passing/refs.ocamlformat/break_string_literals.ml.ref similarity index 89% rename from test/passing/tests/break_string_literals.ml.ref rename to test/passing/refs.ocamlformat/break_string_literals.ml.ref index bad1bde173..eddcdbe28d 100644 --- a/test/passing/tests/break_string_literals.ml.ref +++ b/test/passing/refs.ocamlformat/break_string_literals.ml.ref @@ -27,9 +27,7 @@ let fooooooo = let foooo = Printf.sprintf - "%s\n\ - Usage: infer %s [options]\n\ - See `infer%s --help` for more information." + "%s\nUsage: infer %s [options]\nSee `infer%s --help` for more information." let pp_sep fmt () = F.fprintf fmt ", @,\n" @@ -70,19 +68,19 @@ let fooooooooooo = tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim \ veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea \ commodo consequat. Duis aute irure dolor in reprehenderit in voluptate \ - velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint \ - occaecat cupidatat non proident, sunt in culpa qui officia deserunt \ - mollit anim id est laborum." + velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat \ + cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id \ + est laborum." let fooooooooooo = "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod \ tempor incididunt ut labore et dolore magna aliqua.@;\ - Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi \ - ut aliquip ex ea commodo consequat.@;\ + Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut \ + aliquip ex ea commodo consequat.@;\ Duis aute irure dolor in reprehenderit in voluptate velit esse cillum \ dolore eu fugiat nulla pariatur.@;\ - Excepteur sint occaecat cupidatat non proident, sunt in culpa qui \ - officia deserunt mollit anim id est laborum." + Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia \ + deserunt mollit anim id est laborum." let _ = "abc@,def\n\nghi" @@ -101,6 +99,6 @@ let _ = let _ = Pp.textf - "Failed to parse environment variable: %s=%s Permitted values: \ - if-exists always never Default: %s" + "Failed to parse environment variable: %s=%s Permitted values: if-exists \ + always never Default: %s" var v (to_string default) diff --git a/test/passing/tests/break_struct.ml.ref b/test/passing/refs.ocamlformat/break_struct.ml.ref similarity index 100% rename from test/passing/tests/break_struct.ml.ref rename to test/passing/refs.ocamlformat/break_struct.ml.ref diff --git a/test/passing/tests/cases_exp_grouping.ml.ref b/test/passing/refs.ocamlformat/cases_exp_grouping.ml.ref similarity index 100% rename from test/passing/tests/cases_exp_grouping.ml.ref rename to test/passing/refs.ocamlformat/cases_exp_grouping.ml.ref diff --git a/test/passing/tests/cinaps.ml.ref b/test/passing/refs.ocamlformat/cinaps.ml.ref similarity index 97% rename from test/passing/tests/cinaps.ml.ref rename to test/passing/refs.ocamlformat/cinaps.ml.ref index 4c1d150e85..bc9669f67c 100644 --- a/test/passing/tests/cinaps.ml.ref +++ b/test/passing/refs.ocamlformat/cinaps.ml.ref @@ -63,7 +63,9 @@ let foo = foo (*$*) -(*$ (* x *) *) +(*$ (* + x + *) *) (*$*) diff --git a/test/passing/refs.ocamlformat/class_expr.ml.ref b/test/passing/refs.ocamlformat/class_expr.ml.ref new file mode 100644 index 0000000000..89f61866d5 --- /dev/null +++ b/test/passing/refs.ocamlformat/class_expr.ml.ref @@ -0,0 +1,22 @@ +class c (`I i) = x + +class c `I = x + +class c i = x + +class c (* xx *) i (* yy *) = x + +class c = + object + method class_infos : 'a. ('a -> 'res) -> 'a class_infos -> 'res = + fun _a + {pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes} -> + let pci_virt = self#virtual_flag pci_virt in + let pci_params = self#list in + () + end + +class c = + (let () = print_endline "Class init" in + with_param ) + () diff --git a/test/passing/tests/class_sig-after.mli.ref b/test/passing/refs.ocamlformat/class_sig-after.mli.ref similarity index 100% rename from test/passing/tests/class_sig-after.mli.ref rename to test/passing/refs.ocamlformat/class_sig-after.mli.ref diff --git a/test/passing/tests/class_sig.mli.ref b/test/passing/refs.ocamlformat/class_sig.mli.ref similarity index 100% rename from test/passing/tests/class_sig.mli.ref rename to test/passing/refs.ocamlformat/class_sig.mli.ref diff --git a/test/passing/tests/class_type.ml.ref b/test/passing/refs.ocamlformat/class_type.ml.ref similarity index 100% rename from test/passing/tests/class_type.ml.ref rename to test/passing/refs.ocamlformat/class_type.ml.ref diff --git a/test/passing/refs.ocamlformat/cmdline_override.ml.ref b/test/passing/refs.ocamlformat/cmdline_override.ml.ref new file mode 100644 index 0000000000..b098640eef --- /dev/null +++ b/test/passing/refs.ocamlformat/cmdline_override.ml.ref @@ -0,0 +1,3 @@ +let x = 1 + +let y = 2 diff --git a/test/passing/refs.ocamlformat/cmdline_override2.ml.ref b/test/passing/refs.ocamlformat/cmdline_override2.ml.ref new file mode 100644 index 0000000000..b098640eef --- /dev/null +++ b/test/passing/refs.ocamlformat/cmdline_override2.ml.ref @@ -0,0 +1,3 @@ +let x = 1 + +let y = 2 diff --git a/test/passing/refs.ocamlformat/coerce.ml.ref b/test/passing/refs.ocamlformat/coerce.ml.ref new file mode 100644 index 0000000000..69a6f14959 --- /dev/null +++ b/test/passing/refs.ocamlformat/coerce.ml.ref @@ -0,0 +1,29 @@ +let _ = + let a :> x = v in + let a : x :> y = v in + let a = (v :> x) in + let a = (v : x :> y) in + let a : x :> y = (v : x :> y) in + () + +let a :> x = v + +let a : x :> y = v + +let a = (v :> x) + +let a = (v : x :> y) + +let a : x :> y = (v : x :> y) + +class c = + let a :> x = v in + let a : x :> y = v in + let a = (v :> x) in + let a = (v : x :> y) in + let a : x :> y = (v : x :> y) in + object end + +let f (type a) :> a M.u = function z -> z + +let f x (type a) :> a M.u = function z -> z diff --git a/test/passing/refs.ocamlformat/comment_breaking.ml.ref b/test/passing/refs.ocamlformat/comment_breaking.ml.ref new file mode 100644 index 0000000000..9874f6afea --- /dev/null +++ b/test/passing/refs.ocamlformat/comment_breaking.ml.ref @@ -0,0 +1,8 @@ +let () = + foo aaaaaaaaaa bbbbbbbbbb cccccccccc |> (ignore : t -> _) ; + bar dddddddddd eeeeeeeeee ffffffffff |> (ignore : t -> _) + +let () = + (* this comment should not change breaking of the following line *) + foo aaaaaaaaaa bbbbbbbbbb cccccccccc |> (ignore : t -> _) ; + bar dddddddddd eeeeeeeeee ffffffffff |> (ignore : t -> _) diff --git a/test/passing/refs.ocamlformat/comment_header.ml.ref b/test/passing/refs.ocamlformat/comment_header.ml.ref new file mode 100644 index 0000000000..4005932ee5 --- /dev/null +++ b/test/passing/refs.ocamlformat/comment_header.ml.ref @@ -0,0 +1,60 @@ +(**************************************************************************) +(* *) +(* XXXXX *) +(* *) +(* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXxx *) +(* *) +(* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *) +(* XXXXXXXXXXXxXX. *) +(* *) +(* XXXXXXXXXXXXXXXXXXX. XXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXX *) +(* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXxX *) +(* XXXXXXX XXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXX XXXXXXXXXXXXXXXXX *) +(* *) +(**************************************************************************) + +(* XXXXXXX xxxxxxxxxxxxx XXXXXXXXXXXXXXXXXXXXx xxxxxxxxx xxxxxxxxx x xxxxxx + xxxxxx. *) + +open Module + +type typ = typ + +(* XXXXXXXXXXXXXX XX XXxxxxxxxx *) + +(* b *) +(*******) +(* *) +(* *) +(* *) +(* *) +(*******) +(* b *) + +(*******) +(* *) +(* *) +(* *) +(* *) +(*****) + +(* xxxxxxxxxxxxxxxxx, xxxxxxx xxxxxx (xxxxxxxxxxxxxx) xxxxxxxxx xxxxxxx + xxxxxxxxxxxxxx xxxxxxxxxxxxx. *) +(* xx xxxxxxxxxxxxxx, x xxxxxxxxxxxxxx "xxxxxxxxx" xxxxxxxxxxxxxxxxxxxx + xxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxx xxxxx. *) + +(* TEST + arguments = "???" + *) + +(* On Windows the runtime expand windows wildcards (asterisks and + * question marks). + * + * This file is a non-regression test for github's PR#1623. + * + * On Windows 64bits, a segfault was triggered when one argument consists + * only of wildcards. + * + * The source code of this test is empty: we just check the arguments + * expansion. + *) diff --git a/test/passing/refs.ocamlformat/comment_in_empty.ml.ref b/test/passing/refs.ocamlformat/comment_in_empty.ml.ref new file mode 100644 index 0000000000..0fbbe5f8bc --- /dev/null +++ b/test/passing/refs.ocamlformat/comment_in_empty.ml.ref @@ -0,0 +1,51 @@ +module M = struct + (* this module is empty *) +end + +module type M = sig + (* this module type is empty *) +end + +class type m = object end (* this class type is empty *) + +let x = object (* this object is empty *) end + +let _ = [ (* this list is empty *) ] + +let _ = (* this list is empty2 *) [] + +let _ = (* this list is empty2 *) [] + +let _ = [| (* this array is empty *) |] + +let _ = f ( (* comment in unit *) ) + +let _ = f "asd" (* te""st *) 3 + +let x = function + | [ (* empty list pat *) ] + | [| (* empty array pat *) |] + | ( (* unit pat *) ) + | "" (* comment *) -> + () + +let x = + object + method x () = {< (* this override is empty *) >} + end + +type t = private [> (*this variant is empty *) ] + +type t = < (* this object type is empty *) > + +type t = < .. (* this object type is empty *) > + +let x = + ( (* Lorem ipsum dolor sit amet, consectetur adipiscing elit. Sed non + risus. Suspendisse lectus tortor, dignissim sit amet, adipiscing nec, + ultricies sed, dolor. *) ) + +let x = + [ (* Lorem ipsum dolor sit amet, consectetur adipiscing elit. Sed non + risus. Suspendisse lectus tortor, dignissim sit amet, adipiscing nec, + ultricies sed, dolor. *) ] diff --git a/test/passing/tests/comment_in_modules.ml.ref b/test/passing/refs.ocamlformat/comment_in_modules.ml.ref similarity index 89% rename from test/passing/tests/comment_in_modules.ml.ref rename to test/passing/refs.ocamlformat/comment_in_modules.ml.ref index 66b488c68f..3d286d0db1 100644 --- a/test/passing/tests/comment_in_modules.ml.ref +++ b/test/passing/refs.ocamlformat/comment_in_modules.ml.ref @@ -13,8 +13,7 @@ module type M = sig end (** Xxxxxxx xxxxxxxx xx xxxxxxx xxxxxxxxxxxxx xxxxxxxxx xx xxxx *) -module Mmmmmmmmmmmmmmmmmmmmmm = - Aaaaaaaaaaaaaaaaaaaaaa.Bbbbbbbbbbbbbbbbbbbbbbbb +module Mmmmmmmmmmmmmmmmmmmmmm = Aaaaaaaaaaaaaaaaaaaaaa.Bbbbbbbbbbbbbbbbbbbbbbbb (** Xxxxxxx xxxxxxxx xx xxxxxxx xxxxxxxxxxxxx xxxxxxxxx xx xxxx *) module Fffffffffffffff (Yyyyyyyyyyyyyyy : Z.S) = diff --git a/test/passing/refs.ocamlformat/comment_last.ml.ref b/test/passing/refs.ocamlformat/comment_last.ml.ref new file mode 100644 index 0000000000..b855292e5a --- /dev/null +++ b/test/passing/refs.ocamlformat/comment_last.ml.ref @@ -0,0 +1,5 @@ +let x = 2 + +let y = 3 + +(*comment*) diff --git a/test/passing/refs.ocamlformat/comment_sparse.ml.ref b/test/passing/refs.ocamlformat/comment_sparse.ml.ref new file mode 100644 index 0000000000..da0b12b351 --- /dev/null +++ b/test/passing/refs.ocamlformat/comment_sparse.ml.ref @@ -0,0 +1,10 @@ +[@@@ocamlformat "break-cases=nested"] + +let f x = + match x with + | `A -> + () + | `B -> + (* Proin ipsum nunc, finibus et finibus, semper et mi. Aenean *) + (* pretium fermentum tellus, a faucibus sagittis et. Cras non *) + () diff --git a/test/passing/refs.ocamlformat/comments-no-wrap.ml.err b/test/passing/refs.ocamlformat/comments-no-wrap.ml.err new file mode 100644 index 0000000000..c4a259bb48 --- /dev/null +++ b/test/passing/refs.ocamlformat/comments-no-wrap.ml.err @@ -0,0 +1,3 @@ +Warning: comments-no-wrap.ml:192 exceeds the margin +Warning: comments-no-wrap.ml:253 exceeds the margin +Warning: comments-no-wrap.ml:406 exceeds the margin diff --git a/test/passing/tests/comments-no-wrap.ml.ref b/test/passing/refs.ocamlformat/comments-no-wrap.ml.ref similarity index 90% rename from test/passing/tests/comments-no-wrap.ml.ref rename to test/passing/refs.ocamlformat/comments-no-wrap.ml.ref index 502d0cd110..fa5dc437a5 100644 --- a/test/passing/tests/comments-no-wrap.ml.ref +++ b/test/passing/refs.ocamlformat/comments-no-wrap.ml.ref @@ -36,24 +36,23 @@ let foo = function Blah, (x, (* old *) y) -> () let foo = function (x, y) (* old *), z -> () -let _ = - if (* a0 *) b (* c0 *) then (* d0 *) e (* f0 *) else (* g0 *) h (* i0 *) +let _ = if (* a0 *) b (* c0 *) then (* d0 *) e (* f0 *) else (* g0 *) h (* i0 *) -let _ = - if (* a1 *) b (* c1 *) then (* d1 *) e (* f1 *) else (* g1 *) h (* i1 *) +let _ = if (* a1 *) b (* c1 *) then (* d1 *) e (* f1 *) else (* g1 *) h (* i1 *) -let _ = - if (* a2 *) B (* c2 *) then (* d2 *) E (* f2 *) else (* g2 *) H (* i2 *) +let _ = if (* a2 *) B (* c2 *) then (* d2 *) E (* f2 *) else (* g2 *) H (* i2 *) -let _ = - if (* a3 *) B (* c3 *) then (* d3 *) E (* f3 *) else (* g3 *) H (* i3 *) +let _ = if (* a3 *) B (* c3 *) then (* d3 *) E (* f3 *) else (* g3 *) H (* i3 *) ;; match x with -| true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" -| false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +| true -> + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" +| false -> + "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" (* this comment should not change the formatting of the following case *) -| false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +| false -> + "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" ;; try f x @@ -65,20 +64,23 @@ with match x with (* this comment is intended to refer to the entire case below *) -| false -> () +| false -> + () ;; match x with | Aaaaaaaaaaaaaaaaaaaa (* this comment is intended to refer to the case below *) - |Bbbbbbbbbbbbbbbbbbbb -> +| Bbbbbbbbbbbbbbbbbbbb -> () let _ = (* this comment is intended to refer to the entire match below *) match x with - | "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" -> () - | "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" -> () + | "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" -> + () + | "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" -> + () module type M = sig val f (* A list of [name], [count] pairs. *) : (string * int) list -> int @@ -206,7 +208,8 @@ let () = let rec fooooooooooo = function (*XX*) - | x :: t (*YY*) -> k + | x :: t (*YY*) -> + k (* AA*) | [ (*BB*) (* CC *) @@ -277,8 +280,10 @@ let _ = try_with (fun () -> (* comment before *) match get () with - | None -> do_something () - | Some _ -> () (* do nothing *) ) + | None -> + do_something () + | Some _ -> + () (* do nothing *) ) let _ = try_with (fun () -> @@ -289,7 +294,8 @@ let _ = match x with | Some y -> ( match y with None -> () | Some z -> incr z (* double some *) ) - | None -> () + | None -> + () type prefix = {sib_extend: int (** add more as needed *) (* extended sib index bit *)} @@ -310,8 +316,7 @@ type t = (* | B *) | C -type foo = Alpha | Beta -[@@ocaml.warning "-37" (* Explanation of warning *)] +type foo = Alpha | Beta [@@ocaml.warning "-37" (* Explanation of warning *)] type foo = | Alpha______________________________ diff --git a/test/passing/refs.ocamlformat/comments.ml.err b/test/passing/refs.ocamlformat/comments.ml.err new file mode 100644 index 0000000000..ad038a2c48 --- /dev/null +++ b/test/passing/refs.ocamlformat/comments.ml.err @@ -0,0 +1,3 @@ +Warning: comments.ml:192 exceeds the margin +Warning: comments.ml:253 exceeds the margin +Warning: comments.ml:406 exceeds the margin diff --git a/test/passing/tests/comments.ml.ref b/test/passing/refs.ocamlformat/comments.ml.ref similarity index 87% rename from test/passing/tests/comments.ml.ref rename to test/passing/refs.ocamlformat/comments.ml.ref index 821cbfc247..fa5dc437a5 100644 --- a/test/passing/tests/comments.ml.ref +++ b/test/passing/refs.ocamlformat/comments.ml.ref @@ -36,24 +36,23 @@ let foo = function Blah, (x, (* old *) y) -> () let foo = function (x, y) (* old *), z -> () -let _ = - if (* a0 *) b (* c0 *) then (* d0 *) e (* f0 *) else (* g0 *) h (* i0 *) +let _ = if (* a0 *) b (* c0 *) then (* d0 *) e (* f0 *) else (* g0 *) h (* i0 *) -let _ = - if (* a1 *) b (* c1 *) then (* d1 *) e (* f1 *) else (* g1 *) h (* i1 *) +let _ = if (* a1 *) b (* c1 *) then (* d1 *) e (* f1 *) else (* g1 *) h (* i1 *) -let _ = - if (* a2 *) B (* c2 *) then (* d2 *) E (* f2 *) else (* g2 *) H (* i2 *) +let _ = if (* a2 *) B (* c2 *) then (* d2 *) E (* f2 *) else (* g2 *) H (* i2 *) -let _ = - if (* a3 *) B (* c3 *) then (* d3 *) E (* f3 *) else (* g3 *) H (* i3 *) +let _ = if (* a3 *) B (* c3 *) then (* d3 *) E (* f3 *) else (* g3 *) H (* i3 *) ;; match x with -| true -> "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" -| false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +| true -> + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" +| false -> + "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" (* this comment should not change the formatting of the following case *) -| false -> "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +| false -> + "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" ;; try f x @@ -65,20 +64,23 @@ with match x with (* this comment is intended to refer to the entire case below *) -| false -> () +| false -> + () ;; match x with | Aaaaaaaaaaaaaaaaaaaa (* this comment is intended to refer to the case below *) - |Bbbbbbbbbbbbbbbbbbbb -> +| Bbbbbbbbbbbbbbbbbbbb -> () let _ = (* this comment is intended to refer to the entire match below *) match x with - | "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" -> () - | "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" -> () + | "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" -> + () + | "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" -> + () module type M = sig val f (* A list of [name], [count] pairs. *) : (string * int) list -> int @@ -184,13 +186,11 @@ let () = (* *) () -(* break when unicode sequence length measured in bytes but ¬ in code - points *) +(* break when unicode sequence length measured in bytes but ¬ in code points *) type t = | Aaaaaaaaaa - (* Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do - eiusmod tempor incididunt ut labore et dolore magna aliqua. *) + (* Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. *) | Bbbbbbbbbb (* foo *) | Bbbbbbbbbb (* foo *) @@ -208,7 +208,8 @@ let () = let rec fooooooooooo = function (*XX*) - | x :: t (*YY*) -> k + | x :: t (*YY*) -> + k (* AA*) | [ (*BB*) (* CC *) @@ -279,8 +280,10 @@ let _ = try_with (fun () -> (* comment before *) match get () with - | None -> do_something () - | Some _ -> () (* do nothing *) ) + | None -> + do_something () + | Some _ -> + () (* do nothing *) ) let _ = try_with (fun () -> @@ -291,7 +294,8 @@ let _ = match x with | Some y -> ( match y with None -> () | Some z -> incr z (* double some *) ) - | None -> () + | None -> + () type prefix = {sib_extend: int (** add more as needed *) (* extended sib index bit *)} @@ -312,8 +316,7 @@ type t = (* | B *) | C -type foo = Alpha | Beta -[@@ocaml.warning "-37" (* Explanation of warning *)] +type foo = Alpha | Beta [@@ocaml.warning "-37" (* Explanation of warning *)] type foo = | Alpha______________________________ @@ -401,8 +404,7 @@ let _ = (* convert from foos to bars blah blah blah blah blah blah blah blah *) foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo#= - (* convert from foos to bars blah blah blah blah blah - blah blah blah *) + (* convert from foos to bars blah blah blah blah blah blah blah blah *) foooooooooooooooooooooooo foooooooooooooooo fooooooooooooooo @@ -434,8 +436,7 @@ type a = b (* a *) as (* b *) 'c (* c *) type t = { (* comment before mutable *) mutable - (* really long comment that doesn't fit on the same line as other - stuff *) + (* really long comment that doesn't fit on the same line as other stuff *) x: int } @@ -445,13 +446,17 @@ let _ = x ^ (y ^ z) [@attr] let _ = () ; - (* indentation preserved *) + (* indentation preserved + *) () ; - (* indentation preserved *) + (* indentation preserved + *) () ; - (* indentation preserved *) + (* indentation preserved + *) () ; - (* indentation not preserved *) + (* indentation not preserved +*) () let vexpr (*aa*) (type (*bb*) a) (*cc*) (type (*dd*) b) (*ee*) : _ -> _ = k diff --git a/test/passing/refs.ocamlformat/comments.mli.ref b/test/passing/refs.ocamlformat/comments.mli.ref new file mode 100644 index 0000000000..0624bb388c --- /dev/null +++ b/test/passing/refs.ocamlformat/comments.mli.ref @@ -0,0 +1,7 @@ +val f : unit +(** docstring *) +(* comment *) + +val g : unit +(** docstring *) +(* comment *) diff --git a/test/passing/refs.ocamlformat/comments_args.ml.ref b/test/passing/refs.ocamlformat/comments_args.ml.ref new file mode 100644 index 0000000000..4825fb9904 --- /dev/null +++ b/test/passing/refs.ocamlformat/comments_args.ml.ref @@ -0,0 +1,33 @@ +[@@@ocamlformat "wrap-fun-args=true"] + +let emit_wrapper_function = + Hhas_function.make function_attributes name body + (Hhas_pos.pos_to_span ast_fun.Ast.f_span) + false (* is_async *) + false (* is_generator *) + false (* is_pair_generator *) + hoisted true (* no_injection *) + true (* inout_wrapper *) + is_interceptable false + (* is_memoize_impl *) + Rx.NonRx false + +[@@@ocamlformat "wrap-fun-args=false"] + +let emit_wrapper_function = + Hhas_function.make + function_attributes + name + body + (Hhas_pos.pos_to_span ast_fun.Ast.f_span) + false (* is_async *) + false (* is_generator *) + false (* is_pair_generator *) + hoisted + true (* no_injection *) + true (* inout_wrapper *) + is_interceptable + false + (* is_memoize_impl *) + Rx.NonRx + false diff --git a/test/passing/refs.ocamlformat/comments_around_disabled.ml.ref b/test/passing/refs.ocamlformat/comments_around_disabled.ml.ref new file mode 100644 index 0000000000..5699506abc --- /dev/null +++ b/test/passing/refs.ocamlformat/comments_around_disabled.ml.ref @@ -0,0 +1,16 @@ +(* cmts *) + +[@@@ocamlformat "disable"] +let () = + () +[@@@ocamlformat "enable"] + +[@@@ocamlformat "disable"] + (* x *) + (* y *) +let x = + x +(* z *) +[@@@ocamlformat "enable"] + +(* cmts *) diff --git a/test/passing/refs.ocamlformat/comments_in_local_let.ml.ref b/test/passing/refs.ocamlformat/comments_in_local_let.ml.ref new file mode 100644 index 0000000000..319bbeede4 --- /dev/null +++ b/test/passing/refs.ocamlformat/comments_in_local_let.ml.ref @@ -0,0 +1,11 @@ +let _ = + (* a *) + let _ = + (* b *) + foo + (* c *) + (* d *) + in + (* e *) + () +(* f *) diff --git a/test/passing/refs.ocamlformat/comments_in_record-break_separator-after.ml.err b/test/passing/refs.ocamlformat/comments_in_record-break_separator-after.ml.err new file mode 100644 index 0000000000..b28e0cb912 --- /dev/null +++ b/test/passing/refs.ocamlformat/comments_in_record-break_separator-after.ml.err @@ -0,0 +1,3 @@ +Warning: comments_in_record-break_separator-after.ml:21 exceeds the margin +Warning: comments_in_record-break_separator-after.ml:39 exceeds the margin +Warning: comments_in_record-break_separator-after.ml:41 exceeds the margin diff --git a/test/passing/tests/comments_in_record-break_separator-after.ml.ref b/test/passing/refs.ocamlformat/comments_in_record-break_separator-after.ml.ref similarity index 88% rename from test/passing/tests/comments_in_record-break_separator-after.ml.ref rename to test/passing/refs.ocamlformat/comments_in_record-break_separator-after.ml.ref index 519accf2f0..7fc1ec8561 100644 --- a/test/passing/tests/comments_in_record-break_separator-after.ml.ref +++ b/test/passing/refs.ocamlformat/comments_in_record-break_separator-after.ml.ref @@ -37,11 +37,10 @@ let x = type t = { a: int option; - (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb - cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) b: float - (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb - cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) } + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) + } type t = | Tuple of {elts: t vector; packed: bool} @@ -105,11 +104,14 @@ let _ = (* TODO *) _ } -> () - | {issuer= _; (* TODO *) _} -> () - | {issuer= _; _ (* TODO *)} -> () + | {issuer= _; (* TODO *) _} -> + () + | {issuer= _; _ (* TODO *)} -> + () | { issuer= _; (* TODO *) _ (* TODO *) } -> () - | {issuer= _; (* TODO *) _ (* TODO *)} -> () + | {issuer= _; (* TODO *) _ (* TODO *)} -> + () diff --git a/test/passing/refs.ocamlformat/comments_in_record-break_separator-before.ml.err b/test/passing/refs.ocamlformat/comments_in_record-break_separator-before.ml.err new file mode 100644 index 0000000000..a56bdc0d93 --- /dev/null +++ b/test/passing/refs.ocamlformat/comments_in_record-break_separator-before.ml.err @@ -0,0 +1,3 @@ +Warning: comments_in_record-break_separator-before.ml:21 exceeds the margin +Warning: comments_in_record-break_separator-before.ml:39 exceeds the margin +Warning: comments_in_record-break_separator-before.ml:41 exceeds the margin diff --git a/test/passing/tests/comments_in_record-break_separator-before.ml.ref b/test/passing/refs.ocamlformat/comments_in_record-break_separator-before.ml.ref similarity index 88% rename from test/passing/tests/comments_in_record-break_separator-before.ml.ref rename to test/passing/refs.ocamlformat/comments_in_record-break_separator-before.ml.ref index d31765c1a1..4e1b5a4aa2 100644 --- a/test/passing/tests/comments_in_record-break_separator-before.ml.ref +++ b/test/passing/refs.ocamlformat/comments_in_record-break_separator-before.ml.ref @@ -37,11 +37,10 @@ let x = type t = { a: int option - (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb - cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) ; b: float - (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb - cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) } + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) + } type t = | Tuple of {elts: t vector; packed: bool} @@ -105,11 +104,14 @@ let _ = ; (* TODO *) _ } -> () - | {issuer= _; (* TODO *) _} -> () - | {issuer= _; _ (* TODO *)} -> () + | {issuer= _; (* TODO *) _} -> + () + | {issuer= _; _ (* TODO *)} -> + () | { issuer= _ ; (* TODO *) _ (* TODO *) } -> () - | {issuer= _; (* TODO *) _ (* TODO *)} -> () + | {issuer= _; (* TODO *) _ (* TODO *)} -> + () diff --git a/test/passing/refs.ocamlformat/comments_in_record.ml.err b/test/passing/refs.ocamlformat/comments_in_record.ml.err new file mode 100644 index 0000000000..5b31204c02 --- /dev/null +++ b/test/passing/refs.ocamlformat/comments_in_record.ml.err @@ -0,0 +1,3 @@ +Warning: comments_in_record.ml:21 exceeds the margin +Warning: comments_in_record.ml:39 exceeds the margin +Warning: comments_in_record.ml:41 exceeds the margin diff --git a/test/passing/tests/comments_in_record.ml.ref b/test/passing/refs.ocamlformat/comments_in_record.ml.ref similarity index 88% rename from test/passing/tests/comments_in_record.ml.ref rename to test/passing/refs.ocamlformat/comments_in_record.ml.ref index d31765c1a1..4e1b5a4aa2 100644 --- a/test/passing/tests/comments_in_record.ml.ref +++ b/test/passing/refs.ocamlformat/comments_in_record.ml.ref @@ -37,11 +37,10 @@ let x = type t = { a: int option - (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb - cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) ; b: float - (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb - cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) } + (* aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccc ddddddddddddddddd eeeee *) + } type t = | Tuple of {elts: t vector; packed: bool} @@ -105,11 +104,14 @@ let _ = ; (* TODO *) _ } -> () - | {issuer= _; (* TODO *) _} -> () - | {issuer= _; _ (* TODO *)} -> () + | {issuer= _; (* TODO *) _} -> + () + | {issuer= _; _ (* TODO *)} -> + () | { issuer= _ ; (* TODO *) _ (* TODO *) } -> () - | {issuer= _; (* TODO *) _ (* TODO *)} -> () + | {issuer= _; (* TODO *) _ (* TODO *)} -> + () diff --git a/test/passing/tests/crlf_to_crlf.ml.ref b/test/passing/refs.ocamlformat/crlf_to_crlf.ml.ref similarity index 80% rename from test/passing/tests/crlf_to_crlf.ml.ref rename to test/passing/refs.ocamlformat/crlf_to_crlf.ml.ref index d4dad84ea5..02ce9041bc 100644 --- a/test/passing/tests/crlf_to_crlf.ml.ref +++ b/test/passing/refs.ocamlformat/crlf_to_crlf.ml.ref @@ -16,8 +16,7 @@ foo {[ let verbatim s = - s |> String.split_lines - |> List.map ~f:String.strip + s |> String.split_lines |> List.map ~f:String.strip |> fun s -> list s "@," Fmt.str ]} *) diff --git a/test/passing/tests/crlf_to_lf.ml.ref b/test/passing/refs.ocamlformat/crlf_to_lf.ml.ref similarity index 86% rename from test/passing/tests/crlf_to_lf.ml.ref rename to test/passing/refs.ocamlformat/crlf_to_lf.ml.ref index 095adcbfb7..6f7170ad7b 100644 --- a/test/passing/tests/crlf_to_lf.ml.ref +++ b/test/passing/refs.ocamlformat/crlf_to_lf.ml.ref @@ -16,8 +16,7 @@ foo {[ let verbatim s = - s |> String.split_lines - |> List.map ~f:String.strip + s |> String.split_lines |> List.map ~f:String.strip |> fun s -> list s "@," Fmt.str ]} *) diff --git a/test/passing/refs.ocamlformat/custom_list.ml.ref b/test/passing/refs.ocamlformat/custom_list.ml.ref new file mode 100644 index 0000000000..b2aec183c9 --- /dev/null +++ b/test/passing/refs.ocamlformat/custom_list.ml.ref @@ -0,0 +1,3 @@ +type 'a t = [] | ( :: ) of 'a * 'a t + +let _ = ( :: ) 5 diff --git a/test/passing/refs.ocamlformat/directives.mlt.ref b/test/passing/refs.ocamlformat/directives.mlt.ref new file mode 100644 index 0000000000..35797a12e8 --- /dev/null +++ b/test/passing/refs.ocamlformat/directives.mlt.ref @@ -0,0 +1,7 @@ +(* comment before *) +#directory "+unix" + +#load (* a *) "file" +(* b *) + +(* comment after *) diff --git a/test/passing/refs.ocamlformat/disable_attr.ml.ref b/test/passing/refs.ocamlformat/disable_attr.ml.ref new file mode 100644 index 0000000000..e7671a5070 --- /dev/null +++ b/test/passing/refs.ocamlformat/disable_attr.ml.ref @@ -0,0 +1,4 @@ +[@@@ocamlformat "disable"] + +(** hello *) +let foo = 42 diff --git a/test/passing/refs.ocamlformat/disable_class_type.ml.ref b/test/passing/refs.ocamlformat/disable_class_type.ml.ref new file mode 100644 index 0000000000..d6021357ba --- /dev/null +++ b/test/passing/refs.ocamlformat/disable_class_type.ml.ref @@ -0,0 +1,8 @@ +class type c = + let open [@ocamlformat "disable"] Z + in +z + +class type c = + object [@ocamlformat "disable"] + end diff --git a/test/passing/refs.ocamlformat/disable_conf_attrs.ml.err b/test/passing/refs.ocamlformat/disable_conf_attrs.ml.err new file mode 100644 index 0000000000..090cd8f321 --- /dev/null +++ b/test/passing/refs.ocamlformat/disable_conf_attrs.ml.err @@ -0,0 +1,40 @@ +File "disable_conf_attrs.ml", line 3, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 3, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 5, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 5, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 7, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 7, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 9, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 9, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 11, characters 18-33: +Warning: Configuration in attribute "break-cases=all" ignored. +File "disable_conf_attrs.ml", line 11, characters 18-33: +Warning: Configuration in attribute "break-cases=all" ignored. +File "disable_conf_attrs.ml", line 3, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 3, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 5, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 5, characters 18-46: +Warning: Configuration in attribute "parens-tuple-patterns=always" ignored. +File "disable_conf_attrs.ml", line 7, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 7, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 9, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 9, characters 18-55: +Warning: Configuration in attribute "parens-tuple-patterns=multi-line-only" ignored. +File "disable_conf_attrs.ml", line 11, characters 18-33: +Warning: Configuration in attribute "break-cases=all" ignored. +File "disable_conf_attrs.ml", line 11, characters 18-33: +Warning: Configuration in attribute "break-cases=all" ignored. diff --git a/test/passing/tests/disable_conf_attrs.ml.ref b/test/passing/refs.ocamlformat/disable_conf_attrs.ml.ref similarity index 100% rename from test/passing/tests/disable_conf_attrs.ml.ref rename to test/passing/refs.ocamlformat/disable_conf_attrs.ml.ref diff --git a/test/passing/refs.ocamlformat/disable_local_let.ml.ref b/test/passing/refs.ocamlformat/disable_local_let.ml.ref new file mode 100644 index 0000000000..1ba579e4b6 --- /dev/null +++ b/test/passing/refs.ocamlformat/disable_local_let.ml.ref @@ -0,0 +1,35 @@ +let f () = + let [@ocamlformat "disable"] x = y + in + () + +let f () = + let x = y [@@ocamlformat "disable"] + in + () + +let f () = let open [@ocamlformat "disable"] X + in + () + +let f () = let module [@ocamlformat "disable"] X = Y + in + () + +let f () = let exception [@ocamlformat "disable"] X + in + () + +class c = let open [@ocamlformat "disable"] X + in + x + +class c = + let [@ocamlformat "disable"] x = y + in + object end + +class type c = + let open [@ocamlformat "disable"] X + in + x diff --git a/test/passing/refs.ocamlformat/disabled.ml.ref b/test/passing/refs.ocamlformat/disabled.ml.ref new file mode 100644 index 0000000000..31e753ef30 --- /dev/null +++ b/test/passing/refs.ocamlformat/disabled.ml.ref @@ -0,0 +1,2 @@ +(* this file does not parse and ocamlformat is disabled *) +let = in diff --git a/test/passing/refs.ocamlformat/disabled_attr.ml.ref b/test/passing/refs.ocamlformat/disabled_attr.ml.ref new file mode 100644 index 0000000000..a9a3f92e0c --- /dev/null +++ b/test/passing/refs.ocamlformat/disabled_attr.ml.ref @@ -0,0 +1,21 @@ +let _ = + let disabled = {| + |}[@ocamlformat "disable"] in + () + +let _ = + let disabled = " + "[@ocamlformat "disable"] in + () + +let _ = + let disabled = + begin + (* xxx + + xxx *) + + y + end[@ocamlformat "disable"] + in + () diff --git a/test/passing/refs.ocamlformat/disambiguate.ml.ref b/test/passing/refs.ocamlformat/disambiguate.ml.ref new file mode 100644 index 0000000000..8b6c295426 --- /dev/null +++ b/test/passing/refs.ocamlformat/disambiguate.ml.ref @@ -0,0 +1,32 @@ +[@@@ocamlformat "disambiguate-non-breaking-match"] + +let () = r := (fun () -> f () ; g ()) + +let () = + r := + fun () -> + f () ; g () ; g () ; g () ; g () ; g () ; g () ; g () ; g () ; g () + +let () = r := (function () -> f () ; g ()) + +let () = + r := + function + | () -> + f () ; g () ; g () ; g () ; g () ; g () ; g () ; g () ; g () ; g () + +let () = r := (match () with () -> f () ; g ()) + +let () = + r := + match () with + | () -> + f () ; g () ; g () ; g () ; g () ; g () ; g () ; g () ; g () ; g () + +let () = r := (try () with () -> f () ; g ()) + +let () = + r := + try () + with () -> + f () ; g () ; g () ; g () ; g () ; g () ; g () ; g () ; g () ; g () diff --git a/test/passing/refs.ocamlformat/disambiguated_types.ml.ref b/test/passing/refs.ocamlformat/disambiguated_types.ml.ref new file mode 100644 index 0000000000..9791f4c142 --- /dev/null +++ b/test/passing/refs.ocamlformat/disambiguated_types.ml.ref @@ -0,0 +1,5 @@ +let t : int = 4 + +let x : t/2 = t / 2 + +let x : foo M/2.e0 e/2 = foo M / 2.e0 diff --git a/test/passing/refs.ocamlformat/doc.mld.ref b/test/passing/refs.ocamlformat/doc.mld.ref new file mode 100644 index 0000000000..64508de479 --- /dev/null +++ b/test/passing/refs.ocamlformat/doc.mld.ref @@ -0,0 +1,164 @@ +{0 Parent/Child Specification} +This parent/child specification allows more flexible output support, e.g., per +library documentation. See +{{:https://v3.ocaml.org/packages}v3.ocaml.org/packages}. + +The rules are; + +- [.mld] files may or may not have a parent [.mld]. +- Compilation units must have a parent [.mld]. +- The parent [.mld] file must be compiled before any of its children, and the + children must be specified at the parent's compilation time. +- The output paths of [.mld] files and compilation units are subdirectories of + their parent's output directory. +- The output directory of a [.mld] file [x.mld] with children is + [<parent_output_directory>/x], and its file name is [index.html]. That is to + say, [<parent_output_directory>/x/index.html] +- The output directory of a [.mld] file [x.mld] without children is + [<parent_output_directory> /x.html] +- The output directory of a compilation unit [X] is + [<parent_output_directory>/X/index.html] + +{b Note:} The [--pkg <package>] option is still supported for backward +compatibility in [odoc >= v2.0.0], although it's now equivalent to specifying a +parent [.mld] file. + +For example, let's consider [John] whose is [Doe] and [Mark]'s father. [Doe] has +children, [Max], and page [foo], whereas [Mark] has no children. That is to say, +[john.mld], [doe.mld], [mark.mld], [max.mld], [foo.ml] respectively. For +instance; + +[john.mld] + +{v +{0 About John} + +I'm John the father to {{!page-doe}Doe} and {{!page-mark}Mark}. +v} + +[doe.mld] + +{v +{0 About Doe} + +I'm Doe, the; +- son to {{!page-john}John} +- brother to {{!page-mark}Mark} +- father to {{!page-max}Max} + +I also own page {{!page-foo}foo} +v} + +[mark.mld] + +{v +{0 About Mark} + +I'm Mark {{!page-doe}Doe}'s brother and I have no children. +v} + +[max.mld] + +{v +{0 About Max} + +I'm Max, the child to {{!page-doe}Doe} +v} + +[foo.ml] + +{[ + (** I'm foo, a page child to Doe *) +]} + +{2 Compilation} + +{v +$ ocamlc -c -bin-annot foo.ml + && odoc compile john.mld -c page-doe -c page-mark + && odoc compile doe.mld -I . --parent page-john -c page-max -c foo + && odoc compile max.mld -I . --parent page-doe + && odoc compile foo.cmt -I . --parent page-doe + && odoc compile mark.mld -I . --parent page-john +v} + +The output of the compilation phase will be [.odoc] files, where each will be +linked by invoking the [odoc link] command on them. + +{2 Linking} + +[odoc link -I . <file>.odoc] + +{v +$ odoc link -I . page-john.odoc + && odoc link -I . page-doe.odoc + && odoc link -I . page-mark.odoc + && odoc link -I . page-max.odoc + && odoc link -I . foo.odoc +v} + +The output of the [odoc link] command is an [.odocl] file, by default, in the +same path as the original [.odoc] file. + +{2 Generating HTML} +{v +$ odoc html-generate --indent -o html page-john.odocl + && odoc html-generate --indent -o html page-doe.odocl + && odoc html-generate --indent -o html page-mark.odocl + && odoc html-generate --indent -o html page-max.odocl + && odoc html-generate --indent -o html foo.odocl + && odoc support-files -o html +v} + +Then we inspect the contents of the [html] directory using; + +{v +$ ls -R html + highlight.pack.js + john + odoc.css + + html/john: + doe + index.html + mark.html + + html/john/doe: + Foo + index.html + max.html + + html/john/doe/Foo: + index. +v} + +{b Note:} We generated HTML files only for this example, but it's very possible +to generate files in other formats (i.e, latex and man-pages) using: + +- [$ odoc latex-generate -o latex <file>.odocl] +- [$ odoc man-generate -o man <file>.odocl] + +Of course there are different commands that [odoc] uses for other purposes; +e.g., for inspection: + +- [odoc <html/latex/man>-targets ...] takes a glimpse of the expected targets +- [odoc compile-deps ...] lists units (with their digest) that need to be + compiled in order to compile the current compilation unit. The unit itself and + its digest is also reported in the output. + +For example, inspecting the dependencies required to compile [foo.cmt], we run + +[odoc compile-deps foo.cmt] + +and we shall get + +{[ + Stdlib aea3513d44d604b62eaff79ad12007b3 + Foo x5ab79b5411a3c3476029260eda0b4a26 + CamlinternalFormatBasics f562e7b79dbe1bb1591060d6b4e854cf +]} + +For more about [odoc] commands, simply invoke [odoc --help] in your shell. + +Preserve the space between a link/reference and its text: {{:foo}bar} +{{:foo} bar} {{!foo}bar} {{!foo} bar} diff --git a/test/passing/refs.ocamlformat/doc_comments-after.ml.err b/test/passing/refs.ocamlformat/doc_comments-after.ml.err new file mode 100644 index 0000000000..510edd45fd --- /dev/null +++ b/test/passing/refs.ocamlformat/doc_comments-after.ml.err @@ -0,0 +1,4 @@ +Warning: doc_comments-after.ml:270 exceeds the margin +Warning: doc_comments-after.ml:271 exceeds the margin +Warning: doc_comments-after.ml:272 exceeds the margin +Warning: doc_comments-after.ml:301 exceeds the margin diff --git a/test/passing/refs.ocamlformat/doc_comments-after.ml.ref b/test/passing/refs.ocamlformat/doc_comments-after.ml.ref new file mode 100644 index 0000000000..fb97e47049 --- /dev/null +++ b/test/passing/refs.ocamlformat/doc_comments-after.ml.ref @@ -0,0 +1,320 @@ +module A = B +(** test *) + +include A +(** @open *) + +include B +(** @open *) + +include A + +type t = C of int (** docstring comment *) + +type t = C of int [@ocaml.doc " docstring attribute "] + +include Mod +(** comment *) + +(** before *) +let x = 2 +(** after *) + +(**floatting1*) +(**floatting2*) + +(**before*) +and y = 2 +(** after *) + +(** A *) +let a = 0 +(** A' *) + +module Comment_placement : sig + type t + (** Type *) + + (** Variant declaration *) + type t = T + + (** Type extension *) + type t += T + + module A : B + (** Module *) + + (** Module *) + module A : sig + type a + + type b + end + + val a : b + (** Val *) + + exception E + (** Exception *) + + include M + (** Include *) + + (** Include *) + include sig + type a + + type b + end + + open M + (** Open *) + + external a : b = "c" + (** External *) + + module rec A : B + (** Rec module *) + + (** Rec module *) + module rec A : sig + type a + + type b + end + + module type A + (** Module type *) + + (** Module type *) + module type A = sig + type a + + type b + end + + class a : b + (** Class *) + + class type a = b + (** Class type *) + + (* [@@@some attribute] *) + (* (** Attribute *) *) + + [%%some extension] + (** Extension *) + + (** A *) + external a : b = "double_comment" + (** B *) + + (** This comment goes before *) + module S_ext : sig + type t + end + + module Index : Index.S + (** This one goes after *) + + (** This one _still_ goes after *) + module Index2 + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end + + (** Doc comment still goes after *) + module Make (Config : sig + val blah : string + + (* this could be a really long signature *) + end) : S + + module Gen () : S + (** Generative functor *) +end = struct + type t = {a: int} + (** Type *) + + (** Variant declaration *) + type t = T + + (** Type extension *) + type t += T + + module A = B + (** Module *) + + (** Module *) + module A = struct + type a = A + + type b = B + end + + (** Module *) + module A : sig + type a + + type b + end = + B + + (** Let *) + let a = b + + exception E + (** Exception *) + + include M + (** Include *) + + (** Include *) + include struct + type a = A + + type b = B + end + + open M + (** Open *) + + external a : b = "c" + (** External *) + + module rec A : B = C + (** Rec module *) + + (** Rec module *) + module rec A : B = struct + type a = A + + type b = B + end + + module type A = B + (** Module type *) + + (** Module type *) + module type A = sig + type a + + type b + end + + class a = b + (** Class *) + + (** Class *) + class b = + object + method f = 0 + (** Method *) + + inherit a + (** Inherit *) + + val x = 1 + (** Val *) + + constraint 'a = [> ] + (** Constraint *) + + initializer do_init () + (** Initialiser *) + end + + class type a = b + (** Class type *) + + (* [@@@some attribute] *) + (* (** Attribute *) *) + + [%%some extension] + (** Extension *) + + (* ;; *) + (* (** Eval *) *) + (* 1 + 1 *) + (* ;; *) + + (** A *) + external a : b = "double_comment" + (** B *) +end + +(** A *) +exception A of int +(** C *) + +(** {1:lbl Heading} *) + +(** {2 heading without label} *) + +module A = struct + module B = struct + (** It does not try to saturate + (1a) A = B + C /\ B = D + E => A = C + D + E + Nor combine more than 2 equations + (1b) A = B + C /\ B = D + E /\ F = C + D + E => A = F + + xxxxxxxxxxxxxxxxxxxxxxxxxxxx + (2) A = B + C /\ B = D + E => A = C + D - E + *) + let a b = () + end +end + +(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident, + * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before + * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *) +let _ = () + +(** Tags without text *) + +(** @see <Abc> *) + +(** @before a *) + +(** @deprecated *) + +(** @param b *) + +(** @raise c *) + +(** @return *) + +(** @see 'file' *) + +(** @see "title" *) + +(** + +starts with linebreaks +*) +let a = 1 + +(** {@metadata[ Code block with metadata field ]} *) + +(** {@some_tag[ Code block with metadata field. This is a big block that should hopefully break ]} *) + +(** {@ocaml[ + let _ = + f + @@ + { aaa= aaa bbb ccc + ; bbb= aaa bbb ccc + ; ccc= aaa bbb ccc } + >>= fun () -> + let _ = x in + f @@ g @@ h @@ fun x -> y + ]} *) + +(**{v + + foo + +v}*) diff --git a/test/passing/refs.ocamlformat/doc_comments-before-except-val.ml.err b/test/passing/refs.ocamlformat/doc_comments-before-except-val.ml.err new file mode 100644 index 0000000000..16e02cfe1c --- /dev/null +++ b/test/passing/refs.ocamlformat/doc_comments-before-except-val.ml.err @@ -0,0 +1,4 @@ +Warning: doc_comments-before-except-val.ml:270 exceeds the margin +Warning: doc_comments-before-except-val.ml:271 exceeds the margin +Warning: doc_comments-before-except-val.ml:272 exceeds the margin +Warning: doc_comments-before-except-val.ml:301 exceeds the margin diff --git a/test/passing/refs.ocamlformat/doc_comments-before-except-val.ml.ref b/test/passing/refs.ocamlformat/doc_comments-before-except-val.ml.ref new file mode 100644 index 0000000000..ebb1c7c0b0 --- /dev/null +++ b/test/passing/refs.ocamlformat/doc_comments-before-except-val.ml.ref @@ -0,0 +1,320 @@ +(** test *) +module A = B + +(** @open *) +include A + +(** @open *) +include B + +include A + +type t = C of int (** docstring comment *) + +type t = C of int [@ocaml.doc " docstring attribute "] + +(** comment *) +include Mod + +(** before *) +let x = 2 +(** after *) + +(**floatting1*) +(**floatting2*) + +(**before*) +and y = 2 +(** after *) + +(** A *) +let a = 0 +(** A' *) + +module Comment_placement : sig + (** Type *) + type t + + (** Variant declaration *) + type t = T + + (** Type extension *) + type t += T + + (** Module *) + module A : B + + (** Module *) + module A : sig + type a + + type b + end + + val a : b + (** Val *) + + (** Exception *) + exception E + + (** Include *) + include M + + (** Include *) + include sig + type a + + type b + end + + (** Open *) + open M + + external a : b = "c" + (** External *) + + (** Rec module *) + module rec A : B + + (** Rec module *) + module rec A : sig + type a + + type b + end + + (** Module type *) + module type A + + (** Module type *) + module type A = sig + type a + + type b + end + + (** Class *) + class a : b + + (** Class type *) + class type a = b + + (* [@@@some attribute] *) + (* (** Attribute *) *) + + (** Extension *) + [%%some extension] + + (** A *) + external a : b = "double_comment" + (** B *) + + (** This comment goes before *) + module S_ext : sig + type t + end + + (** This one goes after *) + module Index : Index.S + + (** This one _still_ goes after *) + module Index2 + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end + + (** Doc comment still goes after *) + module Make (Config : sig + val blah : string + + (* this could be a really long signature *) + end) : S + + (** Generative functor *) + module Gen () : S +end = struct + (** Type *) + type t = {a: int} + + (** Variant declaration *) + type t = T + + (** Type extension *) + type t += T + + (** Module *) + module A = B + + (** Module *) + module A = struct + type a = A + + type b = B + end + + (** Module *) + module A : sig + type a + + type b + end = + B + + (** Let *) + let a = b + + (** Exception *) + exception E + + (** Include *) + include M + + (** Include *) + include struct + type a = A + + type b = B + end + + (** Open *) + open M + + external a : b = "c" + (** External *) + + (** Rec module *) + module rec A : B = C + + (** Rec module *) + module rec A : B = struct + type a = A + + type b = B + end + + (** Module type *) + module type A = B + + (** Module type *) + module type A = sig + type a + + type b + end + + (** Class *) + class a = b + + (** Class *) + class b = + object + (** Method *) + method f = 0 + + (** Inherit *) + inherit a + + (** Val *) + val x = 1 + + (** Constraint *) + constraint 'a = [> ] + + (** Initialiser *) + initializer do_init () + end + + (** Class type *) + class type a = b + + (* [@@@some attribute] *) + (* (** Attribute *) *) + + (** Extension *) + [%%some extension] + + (* ;; *) + (* (** Eval *) *) + (* 1 + 1 *) + (* ;; *) + + (** A *) + external a : b = "double_comment" + (** B *) +end + +(** A *) +exception A of int +(** C *) + +(** {1:lbl Heading} *) + +(** {2 heading without label} *) + +module A = struct + module B = struct + (** It does not try to saturate + (1a) A = B + C /\ B = D + E => A = C + D + E + Nor combine more than 2 equations + (1b) A = B + C /\ B = D + E /\ F = C + D + E => A = F + + xxxxxxxxxxxxxxxxxxxxxxxxxxxx + (2) A = B + C /\ B = D + E => A = C + D - E + *) + let a b = () + end +end + +(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident, + * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before + * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *) +let _ = () + +(** Tags without text *) + +(** @see <Abc> *) + +(** @before a *) + +(** @deprecated *) + +(** @param b *) + +(** @raise c *) + +(** @return *) + +(** @see 'file' *) + +(** @see "title" *) + +(** + +starts with linebreaks +*) +let a = 1 + +(** {@metadata[ Code block with metadata field ]} *) + +(** {@some_tag[ Code block with metadata field. This is a big block that should hopefully break ]} *) + +(** {@ocaml[ + let _ = + f + @@ + { aaa= aaa bbb ccc + ; bbb= aaa bbb ccc + ; ccc= aaa bbb ccc } + >>= fun () -> + let _ = x in + f @@ g @@ h @@ fun x -> y + ]} *) + +(**{v + + foo + +v}*) diff --git a/test/passing/refs.ocamlformat/doc_comments-before.ml.err b/test/passing/refs.ocamlformat/doc_comments-before.ml.err new file mode 100644 index 0000000000..5c9315eff4 --- /dev/null +++ b/test/passing/refs.ocamlformat/doc_comments-before.ml.err @@ -0,0 +1,4 @@ +Warning: doc_comments-before.ml:270 exceeds the margin +Warning: doc_comments-before.ml:271 exceeds the margin +Warning: doc_comments-before.ml:272 exceeds the margin +Warning: doc_comments-before.ml:301 exceeds the margin diff --git a/test/passing/refs.ocamlformat/doc_comments-before.ml.ref b/test/passing/refs.ocamlformat/doc_comments-before.ml.ref new file mode 100644 index 0000000000..ea10968b82 --- /dev/null +++ b/test/passing/refs.ocamlformat/doc_comments-before.ml.ref @@ -0,0 +1,320 @@ +(** test *) +module A = B + +(** @open *) +include A + +(** @open *) +include B + +include A + +type t = C of int (** docstring comment *) + +type t = C of int [@ocaml.doc " docstring attribute "] + +(** comment *) +include Mod + +(** before *) +let x = 2 +(** after *) + +(**floatting1*) +(**floatting2*) + +(**before*) +and y = 2 +(** after *) + +(** A *) +let a = 0 +(** A' *) + +module Comment_placement : sig + (** Type *) + type t + + (** Variant declaration *) + type t = T + + (** Type extension *) + type t += T + + (** Module *) + module A : B + + (** Module *) + module A : sig + type a + + type b + end + + (** Val *) + val a : b + + (** Exception *) + exception E + + (** Include *) + include M + + (** Include *) + include sig + type a + + type b + end + + (** Open *) + open M + + (** External *) + external a : b = "c" + + (** Rec module *) + module rec A : B + + (** Rec module *) + module rec A : sig + type a + + type b + end + + (** Module type *) + module type A + + (** Module type *) + module type A = sig + type a + + type b + end + + (** Class *) + class a : b + + (** Class type *) + class type a = b + + (* [@@@some attribute] *) + (* (** Attribute *) *) + + (** Extension *) + [%%some extension] + + (** A *) + external a : b = "double_comment" + (** B *) + + (** This comment goes before *) + module S_ext : sig + type t + end + + (** This one goes after *) + module Index : Index.S + + (** This one _still_ goes after *) + module Index2 + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end + + (** Doc comment still goes after *) + module Make (Config : sig + val blah : string + + (* this could be a really long signature *) + end) : S + + (** Generative functor *) + module Gen () : S +end = struct + (** Type *) + type t = {a: int} + + (** Variant declaration *) + type t = T + + (** Type extension *) + type t += T + + (** Module *) + module A = B + + (** Module *) + module A = struct + type a = A + + type b = B + end + + (** Module *) + module A : sig + type a + + type b + end = + B + + (** Let *) + let a = b + + (** Exception *) + exception E + + (** Include *) + include M + + (** Include *) + include struct + type a = A + + type b = B + end + + (** Open *) + open M + + (** External *) + external a : b = "c" + + (** Rec module *) + module rec A : B = C + + (** Rec module *) + module rec A : B = struct + type a = A + + type b = B + end + + (** Module type *) + module type A = B + + (** Module type *) + module type A = sig + type a + + type b + end + + (** Class *) + class a = b + + (** Class *) + class b = + object + (** Method *) + method f = 0 + + (** Inherit *) + inherit a + + (** Val *) + val x = 1 + + (** Constraint *) + constraint 'a = [> ] + + (** Initialiser *) + initializer do_init () + end + + (** Class type *) + class type a = b + + (* [@@@some attribute] *) + (* (** Attribute *) *) + + (** Extension *) + [%%some extension] + + (* ;; *) + (* (** Eval *) *) + (* 1 + 1 *) + (* ;; *) + + (** A *) + external a : b = "double_comment" + (** B *) +end + +(** A *) +exception A of int +(** C *) + +(** {1:lbl Heading} *) + +(** {2 heading without label} *) + +module A = struct + module B = struct + (** It does not try to saturate + (1a) A = B + C /\ B = D + E => A = C + D + E + Nor combine more than 2 equations + (1b) A = B + C /\ B = D + E /\ F = C + D + E => A = F + + xxxxxxxxxxxxxxxxxxxxxxxxxxxx + (2) A = B + C /\ B = D + E => A = C + D - E + *) + let a b = () + end +end + +(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident, + * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before + * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *) +let _ = () + +(** Tags without text *) + +(** @see <Abc> *) + +(** @before a *) + +(** @deprecated *) + +(** @param b *) + +(** @raise c *) + +(** @return *) + +(** @see 'file' *) + +(** @see "title" *) + +(** + +starts with linebreaks +*) +let a = 1 + +(** {@metadata[ Code block with metadata field ]} *) + +(** {@some_tag[ Code block with metadata field. This is a big block that should hopefully break ]} *) + +(** {@ocaml[ + let _ = + f + @@ + { aaa= aaa bbb ccc + ; bbb= aaa bbb ccc + ; ccc= aaa bbb ccc } + >>= fun () -> + let _ = x in + f @@ g @@ h @@ fun x -> y + ]} *) + +(**{v + + foo + +v}*) diff --git a/test/passing/refs.ocamlformat/doc_comments-no-parse-docstrings.mli.err b/test/passing/refs.ocamlformat/doc_comments-no-parse-docstrings.mli.err new file mode 100644 index 0000000000..a790f734e7 --- /dev/null +++ b/test/passing/refs.ocamlformat/doc_comments-no-parse-docstrings.mli.err @@ -0,0 +1,20 @@ +Warning: doc_comments-no-parse-docstrings.mli:79 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:83 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:87 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:91 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:95 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:99 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:103 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:105 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:109 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:117 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:318 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:372 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:463 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:468 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:470 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:547 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:549 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:551 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:585 exceeds the margin +Warning: doc_comments-no-parse-docstrings.mli:613 exceeds the margin diff --git a/test/passing/tests/doc_comments-no-parse-docstrings.mli.ref b/test/passing/refs.ocamlformat/doc_comments-no-parse-docstrings.mli.ref similarity index 100% rename from test/passing/tests/doc_comments-no-parse-docstrings.mli.ref rename to test/passing/refs.ocamlformat/doc_comments-no-parse-docstrings.mli.ref diff --git a/test/passing/refs.ocamlformat/doc_comments-no-wrap.mli.err b/test/passing/refs.ocamlformat/doc_comments-no-wrap.mli.err new file mode 100644 index 0000000000..ff29119d54 --- /dev/null +++ b/test/passing/refs.ocamlformat/doc_comments-no-wrap.mli.err @@ -0,0 +1,20 @@ +Warning: doc_comments-no-wrap.mli:79 exceeds the margin +Warning: doc_comments-no-wrap.mli:83 exceeds the margin +Warning: doc_comments-no-wrap.mli:87 exceeds the margin +Warning: doc_comments-no-wrap.mli:91 exceeds the margin +Warning: doc_comments-no-wrap.mli:95 exceeds the margin +Warning: doc_comments-no-wrap.mli:99 exceeds the margin +Warning: doc_comments-no-wrap.mli:103 exceeds the margin +Warning: doc_comments-no-wrap.mli:105 exceeds the margin +Warning: doc_comments-no-wrap.mli:109 exceeds the margin +Warning: doc_comments-no-wrap.mli:117 exceeds the margin +Warning: doc_comments-no-wrap.mli:318 exceeds the margin +Warning: doc_comments-no-wrap.mli:372 exceeds the margin +Warning: doc_comments-no-wrap.mli:463 exceeds the margin +Warning: doc_comments-no-wrap.mli:468 exceeds the margin +Warning: doc_comments-no-wrap.mli:470 exceeds the margin +Warning: doc_comments-no-wrap.mli:547 exceeds the margin +Warning: doc_comments-no-wrap.mli:549 exceeds the margin +Warning: doc_comments-no-wrap.mli:551 exceeds the margin +Warning: doc_comments-no-wrap.mli:585 exceeds the margin +Warning: doc_comments-no-wrap.mli:613 exceeds the margin diff --git a/test/passing/refs.ocamlformat/doc_comments-no-wrap.mli.ref b/test/passing/refs.ocamlformat/doc_comments-no-wrap.mli.ref new file mode 100644 index 0000000000..ef2f0a1d7b --- /dev/null +++ b/test/passing/refs.ocamlformat/doc_comments-no-wrap.mli.ref @@ -0,0 +1,656 @@ +(** Manpages. See {!Cmdliner.Manpage}. *) + +type block = + [ `S of string + | `P of string + | `Pre of string + | `I of string * string + | `Noblank + | `Blocks of block list ] + +(** Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod *) +include M with type t := t + +val escape : string -> string +(** [escape s] escapes [s] from the doc language. *) + +type title = string * int * string * string * string + +(** {1:standard-section-names Standard section names} *) + +val s_name : string + +(** {1:section-maps Section maps} + + Used for handling the merging of metadata doc strings. *) + +type smap + +val smap_append_block : smap -> sec:string -> block -> smap +(** [smap_append_block smap sec b] appends [b] at the end of section [sec] + creating it at the right place if needed. *) + +(** {1:content-boilerplate Content boilerplate} *) + +val s_environment_intro : block + +(** {1:output Output} *) + +type format = [`Auto | `Pager | `Plain | `Groff] + +val print : + ?errs:Format.formatter + -> ?subst:(string -> string option) + -> format + -> Format.formatter + -> t + -> unit + +(** {1:printers-and-escapes-used-by-cmdliner-module Printers and escapes + used by Cmdliner module} *) + +val subst_vars : + errs:Format.formatter + -> subst:(string -> string option) + -> Buffer.t + -> string + -> string +(** [subst b ~subst s], using [b], substitutes in [s] variables of the form + "$(doc)" by their [subst] definition. This leaves escapes and markup + directives $(markup,...) intact. + + @raise Invalid_argument in case of illegal syntax. *) + +val doc_to_plain : + errs:Format.formatter + -> subst:(string -> string option) + -> Buffer.t + -> string + -> string +(** [doc_to_plain b ~subst s] using [b], subsitutes in [s] variables by + their [subst] definition and renders cmdliner directives to plain text. + + @raise Invalid_argument in case of illegal syntax. *) + +val k : k +(** this is a comment + + @author foo + + @author Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @version foo + + @version Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @see <foo> foo + + @see <https://slash-create.js.org/#/docs/main/latest/class/SlashCreator?scrollTo=registerCommandsIn> this url is very long + + @since foo + + @since Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @before foo [foo] + + @before Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @deprecated [foo] + + @deprecated Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @param foo [foo] + + @param Foooooooooooooo_Baaaaaaaaaaaaar Fooooooooooo foooooooooooo fooooooooooo baaaaaaaaar + + @param Foooooooooooooooooooooooooooooooooooo_baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @raise foo [foo] + + @raise Foooooooooooooooooooooooooooooooooooo_baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @return [foo] + + @inline + + @canonical foo + + @canonical Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar *) + +val x : x +(** a comment + + @version foo *) + +(** Managing Chunks. + + This module exposes functors to store raw contents into append-only + stores as chunks of same size. It exposes the {{!AO} AO} functor which + split the raw contents into [Data] blocks, addressed by [Node] blocks. + That's the usual rope-like representation of strings, but chunk trees + are always build as perfectly well-balanced and blocks are addressed by + their hash (or by the stable keys returned by the underlying store). + + A chunk has the following structure: + + {v + -------------------------- -------------------------- + | uint8_t type | | uint8_t type | + --------------------------- --------------------------- + | uint16_t | | uint64_t | + --------------------------- --------------------------- + | key children[length] | | byte data[length] | + --------------------------- --------------------------- + v} + + [type] is either [Data] (0) or [Index] (1). If the chunk contains data, + [length] is the payload length. Otherwise it is the number of children + that the node has. + + It also exposes {{!AO_stable} AO_stable} which -- as {{!AO} AO} does -- + stores raw contents into chunks of same size. But it also preserves the + nice properpty that values are addressed by their hash. instead of by + the hash of the root chunk node as it is the case for {{!AO} AO}. *) + +(** This is verbatim: + + {v + o o + /\ /\ + /\ /\ + v} + + This is preformated code: + + {[ +let verbatim s = + s |> String.split_lines |> List.map ~f:String.strip + |> fun s -> list s "@," Fmt.str + ]} *) + +(** Lists: + + list with short lines: + + - x + - y + - z + + list with long lines: + + - xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx + xxx xxx xxx xxx xxx xxx xxx + - yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy + yyy yyy yyy yyy yyy yyy yyy + - zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz + zzz zzz zzz zzz zzz zzz zzz + + enumerated list with long lines: + + + xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx + xxx xxx xxx xxx xxx xxx xxx + + yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy + yyy yyy yyy yyy yyy yyy yyy + + zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz + zzz zzz zzz zzz zzz zzz zzz + + list with sub lists: + + {ul + {- xxx + + - a + - b + - c + } + {- yyy + + + a + + b + + c + }} *) + +(** {{:https://github.com/} Github} *) + +(** {:https://github.com/} *) + +(** An array index offset: [exp1\[exp2\]] *) + +(** to extend \{foo syntax *) + +(** The different forms of references in \@see tags. *) + +(** Printf groff string for the \@before information. *) + +(** [a]'c [b]'s [c]'c *) + +(** return true if [\gamma(lhs) \subseteq \gamma(rhs)] *) + +(** Composition of functions: [(f >> g) x] is exactly equivalent to + [g (f (x))]. Left associative. *) + +(** [†] [Struct_rec] is *) + +(** for [Global]s *) + +(** generic command: ∀xs.[foot]-[post] *) + +(** A *) +val foo : int -> unit +(** B *) + +(** C *) + +(** A *) +val foo : int -> unit +(** B *) + +module Foo : sig + (** A *) + val foo : int -> unit + (** B *) + + (** C *) + + (** A *) + val foo : int -> unit + (** B *) +end + +(** [\[ \] \[\] \]] *) + +(** \{ \} \[ \] \@ \@ *) + +(** @canonical Foo *) + +(** @canonical Module.Foo.Bar *) + +(** {v +a + v} *) + +(** {[ +b + ]} *) + +(** - Odoc don't parse + + multiple paragraph in a list *) + +(** {ul + {- Abc + + Def + } + {- Hij + } + {- Klm + + {ul + {- Nop + + Qrs + } + {- Tuv + }} + }} *) + +(** - {v + Abc + def + v} + - {[ +A + B + ]} *) + +(** Code block + {[ Single line ]} + {[ + Multi + line + ]} + {[ + Multi + line + with + indentation + ]} + {[ Single long line HAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA ]} + {[ + With empty + + line + ]} + {[ First line + on the same line + as opening ]} + *) + +module X : sig + (** {[ First line + on the same line + as opening ]} *) +end + +(** {!module:A} {!module:A.B} + + {!module-type:A} {!module-type:A.b} + + {!class:c} {!class:M.c} + + {!class-type:c} {!class-type:M.c} + + {!val:x} {!val:M.x} + + {!type:t} {!type:M.t} + + {!exception:E} {!exception:M.E} + + {!method:m} {!method:c.m} + + {!constructor:C} {!constructor:M.C} + + {!field:f} {!field:t.f} {!field:M.t.f} + *) + +(** {!modules:Foo} + + {!modules:Foo Bar.Baz} + + @canonical Foo + + @canonical Foo.Bar +*) + +(** {%html:<p>Raw markup</p>%} {%Without language%} {%other:Other language%} *) + +(** [Multi + Line] + + [ A lot of spaces ] + + [Very looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong] *) + +(** {[ + for i = 1 to 3 + do + Printf.printf "let x%d = %d\n" i i + done +]} *) + +(** {[ + print_newline (); + List.iter + (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s) + ["+"; "-"; "*"; "/"] +]} *) + +(** {[ + #use "import.cinaps";; + + List.iter all_fields ~f:(fun (name, type_) -> printf "\nexternal get_%s + : unit -> %s = \"get_%s\"" name type_ name) +]} *) + +(** {[ + + + List.iter all_fields ~f:(fun (name, type_) -> printf "\nexternal get_%s + : unit -> %s = \"get_%s\"" name type_ name) +]} *) + +(** {[ + let x = 1 in + + (* fooooooo *) + let y = 2 in + (* foooooooo *) + z +]} *) + +(** {[ + let this = is_short +]} + +{[ + does not parse: verbatim ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+ +]} + +{[ +[@@@ocamlformat "break-separators = after"] + +let fooooooooooooooooo = +[ foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo ] + +]} + +{[ +let fooooooooooooooooo = +[ foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo ] + +]} *) + +(** + This is a comment with code inside + {[ + (** This is a comment with code inside + [ let code inside = f inside ] + *) + let code inside (* comment *) = f inside + ]} + + Code block with metadata: + {@ocaml[ code ]} + + {@ocaml kind=toplevel[ code ]} + + {@ocaml kind=toplevel env=e1[ + (** This is a comment with code inside + [ let code inside = f inside ] + *) + let code inside (* comment *) = f inside + ]} +*) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo} {i fooooooooooooo oooooooo oooooooooo} {b fooooooooooooo oooooooooooo oooooo ooooooo} *) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo} {{!some ref} fooooooooooooo + oooooooo oooooooooo} {b fooooooooooooo oooooooooooo oooooo ooooooo} *) + +(** foooooooooooooooooooooooooooooooooooooooooooooooooo foooooooooooo {b eee + eee eee} *) + +(** foooooooooooooooooooooooooooooooooooooooooooooooooo foooooooooooooooo {b + eee + eee eee} *) + +val f : int + +(***) + +val k : int + +(**) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}}} *) + +(** {e + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}} foooooooo + oooooooooo ooooooooo ooooooooo} *) + +(** foooooooooo fooooooooooo + + {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}} fooooooooooooo + foooooooooo fooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}}} + + {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo}} + + fooooooooooooo foooooooooooooo: + + - foo + - {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo}} + - {e foooooooo oooooooooo ooooooooo ooooooooo} + {i fooooooooooooo oooooooo oooooooooo} + - foo *) + +(** Brackets must not be escaped in the first argument of some tags: *) + +(** @raise [Invalid_argument] if the argument is [None]. Sometimes [t.[x]]. *) + +(** @author [Abc] [def] \[hij\] *) + +(** @author {Abc} {def} \{hij\} *) + +(** @param [id] [def] \[hij\] *) + +(** @raise [exn] [def] \[hij\] *) + +(** @since [Abc] [def] \[hij\] *) + +(** @before [Abc] [def] \[hij\] *) + +(** @version [Abc] [def] \[hij\] *) + +(** @see <[Abc]> [def] \[hij\] *) + +(** @see '[Abc]' [def] \[hij\] *) + +(** @see "[Abc]" [def] \[hij\] *) + +(** \[abc\] *) + +(** *) + +(** *) + +(** [trim " "] is [""] *) + +(** [trms (c × (Σᵢ₌₁ⁿ cᵢ × Πⱼ₌₁ᵐᵢ Xᵢⱼ^pᵢⱼ))] + is the sequence of terms [Xᵢⱼ] for each [i] and [j]. *) + +(** + +Lorem ipsum dolor sit amet, consectetur adipiscing elit. Morbi lacinia odio sit amet lobortis fringilla. Mauris diam massa, vulputate sit amet lacus id, vestibulum bibendum lectus. Nullam tristique justo nisi, gravida dapibus mi pulvinar at. Suspendisse pellentesque odio quis ipsum tempor luctus. + +Cras ultrices, magna sit amet faucibus molestie, sapien dolor ullamcorper lorem, vel viverra tortor augue vel massa. Suspendisse nunc nisi, consequat et ante nec, efficitur dapibus ipsum. Aenean vitae pellentesque odio. Integer et ornare tellus, at tristique elit. + +Phasellus et nisi id neque ultrices vestibulum vitae non tortor. Mauris aliquet at risus sed rhoncus. Ut condimentum rhoncus orci, sit amet eleifend erat tempus quis. + +*) + +(** {[(* a + b *)]} *) + +val a : + fooooooooooooooooooooooooooo (** {[(* a + b *)]} *) + -> fooooooooooooooooooooooooo + +type x = + { a: t (** {[(* a + b *)]} *) + ; b: [`A (** {[(* a + b *)]} *)] } + +type x = + | A of a (** {[(* a + b *)]} *) + | B of b (** {[(* a + b *)]} *) + +(** Set a different language name in the block metadata to not format as OCaml: + + {@sh[ echo "this""is""only""a""single"(echo word)(echo also) ]} *) + +(**a*) + +(**b*) + +(** Inline math: {m \infty} + + Inline math elements can wrap as well {m \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty} or {m \f\relax{x} = \int_{-\infty}^\infty \f\hat\xi\,e^{2 \pi i \xi x} \,d\xi}. + + Block math: + + {math \infty} + + {math + \infty + } + + {math + + \pi + + } + + {math + + \infty + + \pi + + \pi + + \pi + + } + + {math {m \f\relax{x} = \int_{-\infty}^\infty \f\hat\xi\,e^{2 \pi i \xi x} \,d\xi}} + + {math + % \f is defined as #1f(#2) using the macro + \f\relax{x} = \int_{-\infty}^\infty + \f\hat\xi\,e^{2 \pi i \xi x} + \,d\xi + } +*) + +(** {[ + let _ = {| + Doc-comment contains code blocks that contains string with breaks and + ending with trailing spaces. + |} + ]} *) + +(** ISO-Latin1 characters in identifiers + {[ω]}*) + +(** Here, [my_list=[]]. *) + +(** Here, [my_list=\[\]]. *) + +(** This code block will change due to the brackets being re-escaped. + [ [ \[ [] ] ]. *) + +(** at@ *) + +(** \@at *) + +(** Lists can't be nested + - foo + - module system documentation including + {ol + {- bar} + {- baz} + } +*) + +(** Space before a reference or link text is preserved. A newline is turned + into a space. {{!ref} + with newline} and {{!ref} with space}. *) diff --git a/test/passing/refs.ocamlformat/doc_comments.ml.err b/test/passing/refs.ocamlformat/doc_comments.ml.err new file mode 100644 index 0000000000..b1568309e5 --- /dev/null +++ b/test/passing/refs.ocamlformat/doc_comments.ml.err @@ -0,0 +1,4 @@ +Warning: doc_comments.ml:270 exceeds the margin +Warning: doc_comments.ml:271 exceeds the margin +Warning: doc_comments.ml:272 exceeds the margin +Warning: doc_comments.ml:301 exceeds the margin diff --git a/test/passing/refs.ocamlformat/doc_comments.ml.ref b/test/passing/refs.ocamlformat/doc_comments.ml.ref new file mode 100644 index 0000000000..ebb1c7c0b0 --- /dev/null +++ b/test/passing/refs.ocamlformat/doc_comments.ml.ref @@ -0,0 +1,320 @@ +(** test *) +module A = B + +(** @open *) +include A + +(** @open *) +include B + +include A + +type t = C of int (** docstring comment *) + +type t = C of int [@ocaml.doc " docstring attribute "] + +(** comment *) +include Mod + +(** before *) +let x = 2 +(** after *) + +(**floatting1*) +(**floatting2*) + +(**before*) +and y = 2 +(** after *) + +(** A *) +let a = 0 +(** A' *) + +module Comment_placement : sig + (** Type *) + type t + + (** Variant declaration *) + type t = T + + (** Type extension *) + type t += T + + (** Module *) + module A : B + + (** Module *) + module A : sig + type a + + type b + end + + val a : b + (** Val *) + + (** Exception *) + exception E + + (** Include *) + include M + + (** Include *) + include sig + type a + + type b + end + + (** Open *) + open M + + external a : b = "c" + (** External *) + + (** Rec module *) + module rec A : B + + (** Rec module *) + module rec A : sig + type a + + type b + end + + (** Module type *) + module type A + + (** Module type *) + module type A = sig + type a + + type b + end + + (** Class *) + class a : b + + (** Class type *) + class type a = b + + (* [@@@some attribute] *) + (* (** Attribute *) *) + + (** Extension *) + [%%some extension] + + (** A *) + external a : b = "double_comment" + (** B *) + + (** This comment goes before *) + module S_ext : sig + type t + end + + (** This one goes after *) + module Index : Index.S + + (** This one _still_ goes after *) + module Index2 + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end + + (** Doc comment still goes after *) + module Make (Config : sig + val blah : string + + (* this could be a really long signature *) + end) : S + + (** Generative functor *) + module Gen () : S +end = struct + (** Type *) + type t = {a: int} + + (** Variant declaration *) + type t = T + + (** Type extension *) + type t += T + + (** Module *) + module A = B + + (** Module *) + module A = struct + type a = A + + type b = B + end + + (** Module *) + module A : sig + type a + + type b + end = + B + + (** Let *) + let a = b + + (** Exception *) + exception E + + (** Include *) + include M + + (** Include *) + include struct + type a = A + + type b = B + end + + (** Open *) + open M + + external a : b = "c" + (** External *) + + (** Rec module *) + module rec A : B = C + + (** Rec module *) + module rec A : B = struct + type a = A + + type b = B + end + + (** Module type *) + module type A = B + + (** Module type *) + module type A = sig + type a + + type b + end + + (** Class *) + class a = b + + (** Class *) + class b = + object + (** Method *) + method f = 0 + + (** Inherit *) + inherit a + + (** Val *) + val x = 1 + + (** Constraint *) + constraint 'a = [> ] + + (** Initialiser *) + initializer do_init () + end + + (** Class type *) + class type a = b + + (* [@@@some attribute] *) + (* (** Attribute *) *) + + (** Extension *) + [%%some extension] + + (* ;; *) + (* (** Eval *) *) + (* 1 + 1 *) + (* ;; *) + + (** A *) + external a : b = "double_comment" + (** B *) +end + +(** A *) +exception A of int +(** C *) + +(** {1:lbl Heading} *) + +(** {2 heading without label} *) + +module A = struct + module B = struct + (** It does not try to saturate + (1a) A = B + C /\ B = D + E => A = C + D + E + Nor combine more than 2 equations + (1b) A = B + C /\ B = D + E /\ F = C + D + E => A = F + + xxxxxxxxxxxxxxxxxxxxxxxxxxxx + (2) A = B + C /\ B = D + E => A = C + D - E + *) + let a b = () + end +end + +(* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident, + * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before + * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *) +let _ = () + +(** Tags without text *) + +(** @see <Abc> *) + +(** @before a *) + +(** @deprecated *) + +(** @param b *) + +(** @raise c *) + +(** @return *) + +(** @see 'file' *) + +(** @see "title" *) + +(** + +starts with linebreaks +*) +let a = 1 + +(** {@metadata[ Code block with metadata field ]} *) + +(** {@some_tag[ Code block with metadata field. This is a big block that should hopefully break ]} *) + +(** {@ocaml[ + let _ = + f + @@ + { aaa= aaa bbb ccc + ; bbb= aaa bbb ccc + ; ccc= aaa bbb ccc } + >>= fun () -> + let _ = x in + f @@ g @@ h @@ fun x -> y + ]} *) + +(**{v + + foo + +v}*) diff --git a/test/passing/refs.ocamlformat/doc_comments.mli.err b/test/passing/refs.ocamlformat/doc_comments.mli.err new file mode 100644 index 0000000000..bc0fe5ee70 --- /dev/null +++ b/test/passing/refs.ocamlformat/doc_comments.mli.err @@ -0,0 +1,20 @@ +Warning: doc_comments.mli:79 exceeds the margin +Warning: doc_comments.mli:83 exceeds the margin +Warning: doc_comments.mli:87 exceeds the margin +Warning: doc_comments.mli:91 exceeds the margin +Warning: doc_comments.mli:95 exceeds the margin +Warning: doc_comments.mli:99 exceeds the margin +Warning: doc_comments.mli:103 exceeds the margin +Warning: doc_comments.mli:105 exceeds the margin +Warning: doc_comments.mli:109 exceeds the margin +Warning: doc_comments.mli:117 exceeds the margin +Warning: doc_comments.mli:318 exceeds the margin +Warning: doc_comments.mli:372 exceeds the margin +Warning: doc_comments.mli:463 exceeds the margin +Warning: doc_comments.mli:468 exceeds the margin +Warning: doc_comments.mli:470 exceeds the margin +Warning: doc_comments.mli:547 exceeds the margin +Warning: doc_comments.mli:549 exceeds the margin +Warning: doc_comments.mli:551 exceeds the margin +Warning: doc_comments.mli:585 exceeds the margin +Warning: doc_comments.mli:613 exceeds the margin diff --git a/test/passing/refs.ocamlformat/doc_comments.mli.ref b/test/passing/refs.ocamlformat/doc_comments.mli.ref new file mode 100644 index 0000000000..ef2f0a1d7b --- /dev/null +++ b/test/passing/refs.ocamlformat/doc_comments.mli.ref @@ -0,0 +1,656 @@ +(** Manpages. See {!Cmdliner.Manpage}. *) + +type block = + [ `S of string + | `P of string + | `Pre of string + | `I of string * string + | `Noblank + | `Blocks of block list ] + +(** Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod *) +include M with type t := t + +val escape : string -> string +(** [escape s] escapes [s] from the doc language. *) + +type title = string * int * string * string * string + +(** {1:standard-section-names Standard section names} *) + +val s_name : string + +(** {1:section-maps Section maps} + + Used for handling the merging of metadata doc strings. *) + +type smap + +val smap_append_block : smap -> sec:string -> block -> smap +(** [smap_append_block smap sec b] appends [b] at the end of section [sec] + creating it at the right place if needed. *) + +(** {1:content-boilerplate Content boilerplate} *) + +val s_environment_intro : block + +(** {1:output Output} *) + +type format = [`Auto | `Pager | `Plain | `Groff] + +val print : + ?errs:Format.formatter + -> ?subst:(string -> string option) + -> format + -> Format.formatter + -> t + -> unit + +(** {1:printers-and-escapes-used-by-cmdliner-module Printers and escapes + used by Cmdliner module} *) + +val subst_vars : + errs:Format.formatter + -> subst:(string -> string option) + -> Buffer.t + -> string + -> string +(** [subst b ~subst s], using [b], substitutes in [s] variables of the form + "$(doc)" by their [subst] definition. This leaves escapes and markup + directives $(markup,...) intact. + + @raise Invalid_argument in case of illegal syntax. *) + +val doc_to_plain : + errs:Format.formatter + -> subst:(string -> string option) + -> Buffer.t + -> string + -> string +(** [doc_to_plain b ~subst s] using [b], subsitutes in [s] variables by + their [subst] definition and renders cmdliner directives to plain text. + + @raise Invalid_argument in case of illegal syntax. *) + +val k : k +(** this is a comment + + @author foo + + @author Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @version foo + + @version Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @see <foo> foo + + @see <https://slash-create.js.org/#/docs/main/latest/class/SlashCreator?scrollTo=registerCommandsIn> this url is very long + + @since foo + + @since Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar + + @before foo [foo] + + @before Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @deprecated [foo] + + @deprecated Foooooooooooooooooooooooooooooooooooo Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @param foo [foo] + + @param Foooooooooooooo_Baaaaaaaaaaaaar Fooooooooooo foooooooooooo fooooooooooo baaaaaaaaar + + @param Foooooooooooooooooooooooooooooooooooo_baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @raise foo [foo] + + @raise Foooooooooooooooooooooooooooooooooooo_baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar Foo bar + + @return [foo] + + @inline + + @canonical foo + + @canonical Foooooooooooooooooooooooooooooooooooo.Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar *) + +val x : x +(** a comment + + @version foo *) + +(** Managing Chunks. + + This module exposes functors to store raw contents into append-only + stores as chunks of same size. It exposes the {{!AO} AO} functor which + split the raw contents into [Data] blocks, addressed by [Node] blocks. + That's the usual rope-like representation of strings, but chunk trees + are always build as perfectly well-balanced and blocks are addressed by + their hash (or by the stable keys returned by the underlying store). + + A chunk has the following structure: + + {v + -------------------------- -------------------------- + | uint8_t type | | uint8_t type | + --------------------------- --------------------------- + | uint16_t | | uint64_t | + --------------------------- --------------------------- + | key children[length] | | byte data[length] | + --------------------------- --------------------------- + v} + + [type] is either [Data] (0) or [Index] (1). If the chunk contains data, + [length] is the payload length. Otherwise it is the number of children + that the node has. + + It also exposes {{!AO_stable} AO_stable} which -- as {{!AO} AO} does -- + stores raw contents into chunks of same size. But it also preserves the + nice properpty that values are addressed by their hash. instead of by + the hash of the root chunk node as it is the case for {{!AO} AO}. *) + +(** This is verbatim: + + {v + o o + /\ /\ + /\ /\ + v} + + This is preformated code: + + {[ +let verbatim s = + s |> String.split_lines |> List.map ~f:String.strip + |> fun s -> list s "@," Fmt.str + ]} *) + +(** Lists: + + list with short lines: + + - x + - y + - z + + list with long lines: + + - xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx + xxx xxx xxx xxx xxx xxx xxx + - yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy + yyy yyy yyy yyy yyy yyy yyy + - zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz + zzz zzz zzz zzz zzz zzz zzz + + enumerated list with long lines: + + + xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx + xxx xxx xxx xxx xxx xxx xxx + + yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy yyy + yyy yyy yyy yyy yyy yyy yyy + + zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz zzz + zzz zzz zzz zzz zzz zzz zzz + + list with sub lists: + + {ul + {- xxx + + - a + - b + - c + } + {- yyy + + + a + + b + + c + }} *) + +(** {{:https://github.com/} Github} *) + +(** {:https://github.com/} *) + +(** An array index offset: [exp1\[exp2\]] *) + +(** to extend \{foo syntax *) + +(** The different forms of references in \@see tags. *) + +(** Printf groff string for the \@before information. *) + +(** [a]'c [b]'s [c]'c *) + +(** return true if [\gamma(lhs) \subseteq \gamma(rhs)] *) + +(** Composition of functions: [(f >> g) x] is exactly equivalent to + [g (f (x))]. Left associative. *) + +(** [†] [Struct_rec] is *) + +(** for [Global]s *) + +(** generic command: ∀xs.[foot]-[post] *) + +(** A *) +val foo : int -> unit +(** B *) + +(** C *) + +(** A *) +val foo : int -> unit +(** B *) + +module Foo : sig + (** A *) + val foo : int -> unit + (** B *) + + (** C *) + + (** A *) + val foo : int -> unit + (** B *) +end + +(** [\[ \] \[\] \]] *) + +(** \{ \} \[ \] \@ \@ *) + +(** @canonical Foo *) + +(** @canonical Module.Foo.Bar *) + +(** {v +a + v} *) + +(** {[ +b + ]} *) + +(** - Odoc don't parse + + multiple paragraph in a list *) + +(** {ul + {- Abc + + Def + } + {- Hij + } + {- Klm + + {ul + {- Nop + + Qrs + } + {- Tuv + }} + }} *) + +(** - {v + Abc + def + v} + - {[ +A + B + ]} *) + +(** Code block + {[ Single line ]} + {[ + Multi + line + ]} + {[ + Multi + line + with + indentation + ]} + {[ Single long line HAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA ]} + {[ + With empty + + line + ]} + {[ First line + on the same line + as opening ]} + *) + +module X : sig + (** {[ First line + on the same line + as opening ]} *) +end + +(** {!module:A} {!module:A.B} + + {!module-type:A} {!module-type:A.b} + + {!class:c} {!class:M.c} + + {!class-type:c} {!class-type:M.c} + + {!val:x} {!val:M.x} + + {!type:t} {!type:M.t} + + {!exception:E} {!exception:M.E} + + {!method:m} {!method:c.m} + + {!constructor:C} {!constructor:M.C} + + {!field:f} {!field:t.f} {!field:M.t.f} + *) + +(** {!modules:Foo} + + {!modules:Foo Bar.Baz} + + @canonical Foo + + @canonical Foo.Bar +*) + +(** {%html:<p>Raw markup</p>%} {%Without language%} {%other:Other language%} *) + +(** [Multi + Line] + + [ A lot of spaces ] + + [Very looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong] *) + +(** {[ + for i = 1 to 3 + do + Printf.printf "let x%d = %d\n" i i + done +]} *) + +(** {[ + print_newline (); + List.iter + (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )\n" s s) + ["+"; "-"; "*"; "/"] +]} *) + +(** {[ + #use "import.cinaps";; + + List.iter all_fields ~f:(fun (name, type_) -> printf "\nexternal get_%s + : unit -> %s = \"get_%s\"" name type_ name) +]} *) + +(** {[ + + + List.iter all_fields ~f:(fun (name, type_) -> printf "\nexternal get_%s + : unit -> %s = \"get_%s\"" name type_ name) +]} *) + +(** {[ + let x = 1 in + + (* fooooooo *) + let y = 2 in + (* foooooooo *) + z +]} *) + +(** {[ + let this = is_short +]} + +{[ + does not parse: verbatim ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+/+/+/+/+/+/ ++/+/+ /+/+/ +/+//+/+ +]} + +{[ +[@@@ocamlformat "break-separators = after"] + +let fooooooooooooooooo = +[ foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo ] + +]} + +{[ +let fooooooooooooooooo = +[ foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo +; foooooooooooooooooooooooooooooooo ] + +]} *) + +(** + This is a comment with code inside + {[ + (** This is a comment with code inside + [ let code inside = f inside ] + *) + let code inside (* comment *) = f inside + ]} + + Code block with metadata: + {@ocaml[ code ]} + + {@ocaml kind=toplevel[ code ]} + + {@ocaml kind=toplevel env=e1[ + (** This is a comment with code inside + [ let code inside = f inside ] + *) + let code inside (* comment *) = f inside + ]} +*) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo} {i fooooooooooooo oooooooo oooooooooo} {b fooooooooooooo oooooooooooo oooooo ooooooo} *) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo} {{!some ref} fooooooooooooo + oooooooo oooooooooo} {b fooooooooooooo oooooooooooo oooooo ooooooo} *) + +(** foooooooooooooooooooooooooooooooooooooooooooooooooo foooooooooooo {b eee + eee eee} *) + +(** foooooooooooooooooooooooooooooooooooooooooooooooooo foooooooooooooooo {b + eee + eee eee} *) + +val f : int + +(***) + +val k : int + +(**) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}}} *) + +(** {e + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}} foooooooo + oooooooooo ooooooooo ooooooooo} *) + +(** foooooooooo fooooooooooo + + {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}} fooooooooooooo + foooooooooo fooooo + {i fooooooooooooo oooooooo oooooooooo + {b fooooooooooooo oooooooooooo oooooo ooooooo}}} + + {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo}} + + fooooooooooooo foooooooooooooo: + + - foo + - {e foooooooo oooooooooo ooooooooo ooooooooo + {i fooooooooooooo oooooooo oooooooooo}} + - {e foooooooo oooooooooo ooooooooo ooooooooo} + {i fooooooooooooo oooooooo oooooooooo} + - foo *) + +(** Brackets must not be escaped in the first argument of some tags: *) + +(** @raise [Invalid_argument] if the argument is [None]. Sometimes [t.[x]]. *) + +(** @author [Abc] [def] \[hij\] *) + +(** @author {Abc} {def} \{hij\} *) + +(** @param [id] [def] \[hij\] *) + +(** @raise [exn] [def] \[hij\] *) + +(** @since [Abc] [def] \[hij\] *) + +(** @before [Abc] [def] \[hij\] *) + +(** @version [Abc] [def] \[hij\] *) + +(** @see <[Abc]> [def] \[hij\] *) + +(** @see '[Abc]' [def] \[hij\] *) + +(** @see "[Abc]" [def] \[hij\] *) + +(** \[abc\] *) + +(** *) + +(** *) + +(** [trim " "] is [""] *) + +(** [trms (c × (Σᵢ₌₁ⁿ cᵢ × Πⱼ₌₁ᵐᵢ Xᵢⱼ^pᵢⱼ))] + is the sequence of terms [Xᵢⱼ] for each [i] and [j]. *) + +(** + +Lorem ipsum dolor sit amet, consectetur adipiscing elit. Morbi lacinia odio sit amet lobortis fringilla. Mauris diam massa, vulputate sit amet lacus id, vestibulum bibendum lectus. Nullam tristique justo nisi, gravida dapibus mi pulvinar at. Suspendisse pellentesque odio quis ipsum tempor luctus. + +Cras ultrices, magna sit amet faucibus molestie, sapien dolor ullamcorper lorem, vel viverra tortor augue vel massa. Suspendisse nunc nisi, consequat et ante nec, efficitur dapibus ipsum. Aenean vitae pellentesque odio. Integer et ornare tellus, at tristique elit. + +Phasellus et nisi id neque ultrices vestibulum vitae non tortor. Mauris aliquet at risus sed rhoncus. Ut condimentum rhoncus orci, sit amet eleifend erat tempus quis. + +*) + +(** {[(* a + b *)]} *) + +val a : + fooooooooooooooooooooooooooo (** {[(* a + b *)]} *) + -> fooooooooooooooooooooooooo + +type x = + { a: t (** {[(* a + b *)]} *) + ; b: [`A (** {[(* a + b *)]} *)] } + +type x = + | A of a (** {[(* a + b *)]} *) + | B of b (** {[(* a + b *)]} *) + +(** Set a different language name in the block metadata to not format as OCaml: + + {@sh[ echo "this""is""only""a""single"(echo word)(echo also) ]} *) + +(**a*) + +(**b*) + +(** Inline math: {m \infty} + + Inline math elements can wrap as well {m \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty \infty} or {m \f\relax{x} = \int_{-\infty}^\infty \f\hat\xi\,e^{2 \pi i \xi x} \,d\xi}. + + Block math: + + {math \infty} + + {math + \infty + } + + {math + + \pi + + } + + {math + + \infty + + \pi + + \pi + + \pi + + } + + {math {m \f\relax{x} = \int_{-\infty}^\infty \f\hat\xi\,e^{2 \pi i \xi x} \,d\xi}} + + {math + % \f is defined as #1f(#2) using the macro + \f\relax{x} = \int_{-\infty}^\infty + \f\hat\xi\,e^{2 \pi i \xi x} + \,d\xi + } +*) + +(** {[ + let _ = {| + Doc-comment contains code blocks that contains string with breaks and + ending with trailing spaces. + |} + ]} *) + +(** ISO-Latin1 characters in identifiers + {[ω]}*) + +(** Here, [my_list=[]]. *) + +(** Here, [my_list=\[\]]. *) + +(** This code block will change due to the brackets being re-escaped. + [ [ \[ [] ] ]. *) + +(** at@ *) + +(** \@at *) + +(** Lists can't be nested + - foo + - module system documentation including + {ol + {- bar} + {- baz} + } +*) + +(** Space before a reference or link text is preserved. A newline is turned + into a space. {{!ref} + with newline} and {{!ref} with space}. *) diff --git a/test/passing/refs.ocamlformat/doc_comments_padding.ml.ref b/test/passing/refs.ocamlformat/doc_comments_padding.ml.ref new file mode 100644 index 0000000000..f3b005982a --- /dev/null +++ b/test/passing/refs.ocamlformat/doc_comments_padding.ml.ref @@ -0,0 +1,21 @@ +type t = {a: int (** a *); b: int (** b *)} + +type t = < a: int (** a *) ; b: int (** b *) > + +type t = [`a of int (** a *) | `b of int (** b *)] + +type t = A of int (** a *) | B of int (** b *) + +type t += A of int (** a *) | B of int (** b *) + +[@@@ocamlformat "doc-comments-padding=1"] + +type t = {a: int (** a *); b: int (** b *)} + +type t = < a: int (** a *) ; b: int (** b *) > + +type t = [`a of int (** a *) | `b of int (** b *)] + +type t = A of int (** a *) | B of int (** b *) + +type t += A of int (** a *) | B of int (** b *) diff --git a/test/passing/tests/doc_repl.mld.ref b/test/passing/refs.ocamlformat/doc_repl.mld.ref similarity index 100% rename from test/passing/tests/doc_repl.mld.ref rename to test/passing/refs.ocamlformat/doc_repl.mld.ref diff --git a/test/passing/refs.ocamlformat/docstrings_toplevel_directives.mlt.ref b/test/passing/refs.ocamlformat/docstrings_toplevel_directives.mlt.ref new file mode 100644 index 0000000000..879a339be6 --- /dev/null +++ b/test/passing/refs.ocamlformat/docstrings_toplevel_directives.mlt.ref @@ -0,0 +1,11 @@ +(** Header *) + +#use "something" + +let two = 2 + +[@@@warning "-labels-omitted"] ;; + +Clflags.strict_sequence := false + +let f () = x diff --git a/test/passing/refs.ocamlformat/dune b/test/passing/refs.ocamlformat/dune new file mode 100644 index 0000000000..1ddf72ce93 --- /dev/null +++ b/test/passing/refs.ocamlformat/dune @@ -0,0 +1 @@ +(include ../gen/dune.inc) diff --git a/test/passing/refs.ocamlformat/dune-project b/test/passing/refs.ocamlformat/dune-project new file mode 100644 index 0000000000..c5d3ee94db --- /dev/null +++ b/test/passing/refs.ocamlformat/dune-project @@ -0,0 +1 @@ +(lang dune 2.2) diff --git a/test/passing/refs.ocamlformat/eliom_ext.eliom.err b/test/passing/refs.ocamlformat/eliom_ext.eliom.err new file mode 100644 index 0000000000..674d6a1ad9 --- /dev/null +++ b/test/passing/refs.ocamlformat/eliom_ext.eliom.err @@ -0,0 +1 @@ +Warning: eliom_ext.eliom:48 exceeds the margin diff --git a/test/passing/refs.ocamlformat/eliom_ext.eliom.ref b/test/passing/refs.ocamlformat/eliom_ext.eliom.ref new file mode 100644 index 0000000000..f90e85b03a --- /dev/null +++ b/test/passing/refs.ocamlformat/eliom_ext.eliom.ref @@ -0,0 +1,49 @@ +let%server log str = Lwt_io.write_line Lwt_io.stdout str + +let%client log = ~%(Eliom_client.server_function [%derive.json: string] log) + +let%client () = + Eliom_client.onload + (* NB The service underlying the server_function isn't available on the + client before loading the page. *) + (fun () -> + Lwt.async (fun () -> log "Hello from the client to the server!") ) + +let%client () = + Eliom_client.onload + (* NB The service underlying the server_function isn't available on the + client before loading the page. *) + ~foo:(fun () -> + Lwt.async (fun () -> log "Hello from the client to the server!") ) + +let%client () = + Eliom_client.onload + (* NB The service underlying the server_function isn't available on the + client before loading the page. *) + ~foo:(fun () -> + Lwt.async (fun () -> log "Hello from the client to the server!") ) + bar + +[%%shared +type some_type = int * string list [@@deriving json] + +type another_type = A of some_type | B of another_type [@@deriving json]] + +let%server + ( (s : int Eliom_shared.React.S.t) + , (f : (?step:React.step -> int -> unit) Eliom_shared.Value.t) ) = + Eliom_shared.React.S.create 0 + +let%client incr_s () = + let v = Eliom_shared.React.S.value ~%s in + ~%f (v + 1) + +let%shared msg_of_int i = Printf.sprintf "value is %d" i + +let s_as_string () : string Eliom_shared.React.S.t = + Eliom_shared.React.S.map [%shared msg_of_int] s + +let%shared () = + Eliom_registration.Html.register s (fun () () -> + Lwt.return + (Eliom_tools.F.html ~title:"hybrid" Html.F.(body [h1 [txt "Salut !"]])) ) diff --git a/test/passing/refs.ocamlformat/empty_ml.ml.ref b/test/passing/refs.ocamlformat/empty_ml.ml.ref new file mode 100644 index 0000000000..079a31cf58 --- /dev/null +++ b/test/passing/refs.ocamlformat/empty_ml.ml.ref @@ -0,0 +1,3 @@ +(* test *) + +(* test *) diff --git a/test/passing/refs.ocamlformat/empty_mli.mli.ref b/test/passing/refs.ocamlformat/empty_mli.mli.ref new file mode 100644 index 0000000000..079a31cf58 --- /dev/null +++ b/test/passing/refs.ocamlformat/empty_mli.mli.ref @@ -0,0 +1,3 @@ +(* test *) + +(* test *) diff --git a/test/passing/refs.ocamlformat/empty_mlt.mlt.ref b/test/passing/refs.ocamlformat/empty_mlt.mlt.ref new file mode 100644 index 0000000000..079a31cf58 --- /dev/null +++ b/test/passing/refs.ocamlformat/empty_mlt.mlt.ref @@ -0,0 +1,3 @@ +(* test *) + +(* test *) diff --git a/test/passing/refs.ocamlformat/error1.ml.err b/test/passing/refs.ocamlformat/error1.ml.err new file mode 100644 index 0000000000..1f7352e78a --- /dev/null +++ b/test/passing/refs.ocamlformat/error1.ml.err @@ -0,0 +1,3 @@ +ocamlformat: ignoring "error1.ml" (syntax error) +File "error1.ml", line 2, characters 0-0: +Error: Syntax error diff --git a/test/passing/refs.ocamlformat/error2.ml.err b/test/passing/refs.ocamlformat/error2.ml.err new file mode 100644 index 0000000000..80ff306043 --- /dev/null +++ b/test/passing/refs.ocamlformat/error2.ml.err @@ -0,0 +1,5 @@ +ocamlformat: ignoring "error2.ml" (syntax error) +File "error2.ml", line 1, characters 0-1: +1 | "asdd + ^ +Error: String literal not terminated diff --git a/test/passing/refs.ocamlformat/error3.ml.err b/test/passing/refs.ocamlformat/error3.ml.err new file mode 100644 index 0000000000..e42c4128f0 --- /dev/null +++ b/test/passing/refs.ocamlformat/error3.ml.err @@ -0,0 +1,11 @@ +ocamlformat: ignoring "error3.ml" (misplaced documentation comments - warning 50) +File "error3.ml", line 2, characters 0-13: +2 | (** a or b *) + ^^^^^^^^^^^^^ +Warning 50 [unexpected-docstring]: ambiguous documentation comment + +File "error3.ml", line 3, characters 8-16: +3 | let b = (** ? *) () + ^^^^^^^^ +Warning 50 [unexpected-docstring]: unattached documentation comment (ignored) +Hint: (Warning 50) This file contains a documentation comment (** ... *) that the OCaml compiler does not know how to attach to the AST. OCamlformat does not support these cases. You can find more information at: https://github.com/ocaml-ppx/ocamlformat#overview. If you'd like to disable this check and let ocamlformat make a choice (though it might not be consistent with the ocaml compilers and odoc), you can set the --no-comment-check option. diff --git a/test/passing/refs.ocamlformat/error4.ml.err b/test/passing/refs.ocamlformat/error4.ml.err new file mode 100644 index 0000000000..0a5b3b1a49 --- /dev/null +++ b/test/passing/refs.ocamlformat/error4.ml.err @@ -0,0 +1,9 @@ +File "error4.ml", line 2, characters 0-13: +2 | (** a or b *) + ^^^^^^^^^^^^^ +Warning 50 [unexpected-docstring]: ambiguous documentation comment + +File "error4.ml", line 3, characters 8-16: +3 | let b = (** ? *) () + ^^^^^^^^ +Warning 50 [unexpected-docstring]: unattached documentation comment (ignored) diff --git a/test/passing/refs.ocamlformat/error4.ml.ref b/test/passing/refs.ocamlformat/error4.ml.ref new file mode 100644 index 0000000000..694725ec0a --- /dev/null +++ b/test/passing/refs.ocamlformat/error4.ml.ref @@ -0,0 +1,5 @@ +(** a or b *) +let a = () + +(** a or b *) +let b = (** ? *) () diff --git a/test/passing/tests/escaped_nl.ml.ref b/test/passing/refs.ocamlformat/escaped_nl.ml.ref similarity index 79% rename from test/passing/tests/escaped_nl.ml.ref rename to test/passing/refs.ocamlformat/escaped_nl.ml.ref index 17f03befee..15f86137c9 100644 --- a/test/passing/tests/escaped_nl.ml.ref +++ b/test/passing/refs.ocamlformat/escaped_nl.ml.ref @@ -4,9 +4,9 @@ let s1 = let x = cond 40 `Warning - "Package uses flags that aren't recognised by earlier versions in OPAM \ - 1.2 branch. At the moment, you should use a tag \"flags:foo\" instead \ - for compatibility" + "Package uses flags that aren't recognised by earlier versions in OPAM 1.2 \ + branch. At the moment, you should use a tag \"flags:foo\" instead for \ + compatibility" ~detail:alpha_flags (alpha_flags <> []) let s2 = "bla bla\n bli bli blo" diff --git a/test/passing/refs.ocamlformat/exceptions.ml.ref b/test/passing/refs.ocamlformat/exceptions.ml.ref new file mode 100644 index 0000000000..e9a29200a3 --- /dev/null +++ b/test/passing/refs.ocamlformat/exceptions.ml.ref @@ -0,0 +1,110 @@ +exception EvalError of Error.t [@@deriving sexp] + +exception Duplicate_found of (unit -> Base.Sexp.t) * string + +exception Duplicate_found of ((unit -> Base.Sexp.t) -> string) + +type t = Duplicate_found of (unit -> Base.Sexp.t) * string + +type t = Duplicate_found : (unit -> Base.Sexp.t) * string -> t + +type t = Duplicate_found : ((unit -> Base.Sexp.t) -> string) -> t + +module type S = sig + exception EvalError of Error.t [@@deriving sexp] + + exception Duplicate_found of (unit -> Base.Sexp.t) * string + + exception Duplicate_found of ((unit -> Base.Sexp.t) -> string) + + type t = Duplicate_found of (unit -> Base.Sexp.t) * string + + type t = Duplicate_found : (unit -> Base.Sexp.t) * string -> t + + type t = Duplicate_found : ((unit -> Base.Sexp.t) -> string) -> t +end + +let _ = + let exception Duplicate_found of (unit -> Base.Sexp.t) * string in + let exception Duplicate_found of ((unit -> Base.Sexp.t) -> string) in + () + +exception Recursion_error of (Lv6Id.long as 'id) * (string list as 'stack) + +exception + Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string + | `Unstable of Location.t * string ] ] + +exception E : _ + +exception E : t + +exception E : [%ext t] + +exception E : (t as 'a) + +exception E : (t * t) + +exception E : (t -> t) + +exception E : (module M) + +exception E : [`X | `Y] + +exception E : 'x + +exception E : < x ; y ; .. > + +exception E : #c + +exception E : t #c + +exception E : (t -> t) #c + +exception E : a b #c + +exception E : (a * b) #c + +exception E : (a, b) #c + +exception E : (t -> t) #c + +exception E : (t as 'a) #c + +exception E of _ + +exception E of t + +exception E of [%ext t] + +exception E of (t as 'a) + +exception E of (t * t) + +exception E of (t -> t) + +exception E of (module M) + +exception E of [`X | `Y] + +exception E of 'x + +exception E of < x ; y ; .. > + +exception E of #c + +exception E of t #c + +exception E of (t -> t) #c + +exception E of a b #c + +exception E of (a * b) #c + +exception E of (a, b) #c + +exception E of (t -> t) #c + +exception E of (t as 'a) #c diff --git a/test/passing/refs.ocamlformat/exceptions.mli.ref b/test/passing/refs.ocamlformat/exceptions.mli.ref new file mode 100644 index 0000000000..3e062d9fe7 --- /dev/null +++ b/test/passing/refs.ocamlformat/exceptions.mli.ref @@ -0,0 +1,105 @@ +exception EvalError of Error.t [@@deriving sexp] + +exception Duplicate_found of (unit -> Base.Sexp.t) * string + +exception Duplicate_found of ((unit -> Base.Sexp.t) -> string) + +type t = Duplicate_found of (unit -> Base.Sexp.t) * string + +type t = Duplicate_found : (unit -> Base.Sexp.t) * string -> t + +type t = Duplicate_found : ((unit -> Base.Sexp.t) -> string) -> t + +module type S = sig + exception EvalError of Error.t [@@deriving sexp] + + exception Duplicate_found of (unit -> Base.Sexp.t) * string + + exception Duplicate_found of ((unit -> Base.Sexp.t) -> string) + + type t = Duplicate_found of (unit -> Base.Sexp.t) * string + + type t = Duplicate_found : (unit -> Base.Sexp.t) * string -> t + + type t = Duplicate_found : ((unit -> Base.Sexp.t) -> string) -> t +end + +exception Recursion_error of (Lv6Id.long as 'id) * (string list as 'stack) + +exception + Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string + | `Unstable of Location.t * string ] ] + +exception E : _ + +exception E : t + +exception E : [%ext t] + +exception E : (t as 'a) + +exception E : (t * t) + +exception E : (t -> t) + +exception E : (module M) + +exception E : [`X | `Y] + +exception E : 'x + +exception E : < x ; y ; .. > + +exception E : #c + +exception E : t #c + +exception E : (t -> t) #c + +exception E : a b #c + +exception E : (a * b) #c + +exception E : (a, b) #c + +exception E : (t -> t) #c + +exception E : (t as 'a) #c + +exception E of _ + +exception E of t + +exception E of [%ext t] + +exception E of (t as 'a) + +exception E of (t * t) + +exception E of (t -> t) + +exception E of (module M) + +exception E of [`X | `Y] + +exception E of 'x + +exception E of < x ; y ; .. > + +exception E of #c + +exception E of t #c + +exception E of (t -> t) #c + +exception E of a b #c + +exception E of (a * b) #c + +exception E of (a, b) #c + +exception E of (t -> t) #c + +exception E of (t as 'a) #c diff --git a/test/passing/tests/exp_grouping-parens.ml.ref b/test/passing/refs.ocamlformat/exp_grouping-parens.ml.ref similarity index 92% rename from test/passing/tests/exp_grouping-parens.ml.ref rename to test/passing/refs.ocamlformat/exp_grouping-parens.ml.ref index 637c7afaaa..6f3d661b06 100644 --- a/test/passing/tests/exp_grouping-parens.ml.ref +++ b/test/passing/refs.ocamlformat/exp_grouping-parens.ml.ref @@ -58,8 +58,7 @@ let () = else foooooooooooooooooooooooooo else if foooooooooooooooooooooooooooooooo then fooooooooooooooooooooooooooooooooooo - else if foooooooooooooooooo then - foooooooooooooooooooooooooooooooooo + else if foooooooooooooooooo then foooooooooooooooooooooooooooooooooo else fooooooooooooooooooooo ) else if foooooooooooooooooo then foooooooooooooooooooooooooooooooooo else fooooooooooooooooooooo ) @@ -71,8 +70,7 @@ let () = else foooooooooooooooooooooooooooo ( if foooooooooooooooooooooooooooo then - if foooooooooooooooooooooooooooo then - foooooooooooooooooooooooo + if foooooooooooooooooooooooooooo then foooooooooooooooooooooooo else foooooooooooooooooooooooooo else if foooooooooooooooooooooooooooooooo then fooooooooooooooooooooooooooooooooooo @@ -265,14 +263,20 @@ let _ = let _ = match x with - | A -> ( match B with A -> fooooooooooooo ) - | A -> ( match B with A -> fooooooooooooo | B -> fooooooooooooo ) + | A -> ( + match B with A -> fooooooooooooo ) + | A -> ( + match B with A -> fooooooooooooo | B -> fooooooooooooo ) | A -> ( match B with - | A -> fooooooooooooo - | B -> fooooooooooooo - | C -> fooooooooooooo - | D -> fooooooooooooo ) + | A -> + fooooooooooooo + | B -> + fooooooooooooo + | C -> + fooooooooooooo + | D -> + fooooooooooooo ) let () = ( add_test @@ -323,7 +327,8 @@ let x = Some (path, dist) with Not_found | Not_found_s _ -> None end - | pd -> pd + | pd -> + pd in () diff --git a/test/passing/tests/exp_grouping.ml.ref b/test/passing/refs.ocamlformat/exp_grouping.ml.ref similarity index 92% rename from test/passing/tests/exp_grouping.ml.ref rename to test/passing/refs.ocamlformat/exp_grouping.ml.ref index 1cf112ff77..b32f941cb6 100644 --- a/test/passing/tests/exp_grouping.ml.ref +++ b/test/passing/refs.ocamlformat/exp_grouping.ml.ref @@ -66,8 +66,7 @@ let () = else foooooooooooooooooooooooooo else if foooooooooooooooooooooooooooooooo then fooooooooooooooooooooooooooooooooooo - else if foooooooooooooooooo then - foooooooooooooooooooooooooooooooooo + else if foooooooooooooooooo then foooooooooooooooooooooooooooooooooo else fooooooooooooooooooooo end else if foooooooooooooooooo then foooooooooooooooooooooooooooooooooo @@ -81,8 +80,7 @@ let () = else foooooooooooooooooooooooooooo ( if foooooooooooooooooooooooooooo then - if foooooooooooooooooooooooooooo then - foooooooooooooooooooooooo + if foooooooooooooooooooooooooooo then foooooooooooooooooooooooo else foooooooooooooooooooooooooo else if foooooooooooooooooooooooooooooooo then fooooooooooooooooooooooooooooooooooo @@ -298,15 +296,23 @@ let _ = let _ = match x with - | A -> begin match B with A -> fooooooooooooo end - | A -> begin match B with A -> fooooooooooooo | B -> fooooooooooooo end | A -> begin - match B with - | A -> fooooooooooooo - | B -> fooooooooooooo - | C -> fooooooooooooo - | D -> fooooooooooooo + match B with A -> fooooooooooooo + end + | A -> begin + match B with A -> fooooooooooooo | B -> fooooooooooooo end + | A -> begin + match B with + | A -> + fooooooooooooo + | B -> + fooooooooooooo + | C -> + fooooooooooooo + | D -> + fooooooooooooo + end let () = begin @@ -377,7 +383,8 @@ let x = Some (path, dist) with Not_found | Not_found_s _ -> None end - | pd -> pd + | pd -> + pd in () diff --git a/test/passing/refs.ocamlformat/exp_record.ml.ref b/test/passing/refs.ocamlformat/exp_record.ml.ref new file mode 100644 index 0000000000..b0b49468d3 --- /dev/null +++ b/test/passing/refs.ocamlformat/exp_record.ml.ref @@ -0,0 +1,13 @@ +let x = {a= 1; b= true} + +let x = {a: int = b} + +let x {a: int = b} = 2 + +[@@@ocamlformat "space-around-records"] + +let x = { a= 1; b= true } + +let x = { a: int = b } + +let x { a: int = b } = 2 diff --git a/test/passing/refs.ocamlformat/expect_test.ml.err b/test/passing/refs.ocamlformat/expect_test.ml.err new file mode 100644 index 0000000000..a98bc456e5 --- /dev/null +++ b/test/passing/refs.ocamlformat/expect_test.ml.err @@ -0,0 +1,3 @@ +Warning: expect_test.ml:9 exceeds the margin +Warning: expect_test.ml:15 exceeds the margin +Warning: expect_test.ml:24 exceeds the margin diff --git a/test/passing/refs.ocamlformat/expect_test.ml.ref b/test/passing/refs.ocamlformat/expect_test.ml.ref new file mode 100644 index 0000000000..990375572f --- /dev/null +++ b/test/passing/refs.ocamlformat/expect_test.ml.ref @@ -0,0 +1,25 @@ +let%expect_test _ = e + +let%bench "test" = fun () -> () + +let%expect_test _ = + assert false ; + [%expect.unreachable] +[@@expect.uncaught_exn + {| + (* CR expect_test_collector: This test expectation appears to contain a backtrace. + This is strongly discouraged as backtraces are fragile. + Please change this test to not include a backtrace. *) + + "Assert_failure test.ml:5:6" + Raised at file "test.ml", line 4, characters 6-18 + Called from file "collector/expect_test_collector.ml", line 225, characters 12-19 |}] + +let _ = + assert false ; + [%expect.unreachable] +[@@expect.uncaught_exn + {| + "Assert_failure test.ml:5:6" + Raised at file "test.ml", line 4, characters 6-18 + Called from file "collector/expect_test_collector.ml", line 225, characters 12-19 |}] diff --git a/test/passing/tests/extensions-indent.ml.ref b/test/passing/refs.ocamlformat/extensions-indent.ml.ref similarity index 98% rename from test/passing/tests/extensions-indent.ml.ref rename to test/passing/refs.ocamlformat/extensions-indent.ml.ref index dec5ab6dba..65e42c1b21 100644 --- a/test/passing/tests/extensions-indent.ml.ref +++ b/test/passing/refs.ocamlformat/extensions-indent.ml.ref @@ -47,8 +47,7 @@ let _ = ([%ext? (x : x)] : [%ext? (x : x)]) [%%ext 11111111111111111111] -[%%ext - 11111111111111111111111 22222222222222222222222 33333333333333333333333] +[%%ext 11111111111111111111111 22222222222222222222222 33333333333333333333333] [%%ext 11111111111111111111 ;; diff --git a/test/passing/tests/extensions-indent.mli.ref b/test/passing/refs.ocamlformat/extensions-indent.mli.ref similarity index 100% rename from test/passing/tests/extensions-indent.mli.ref rename to test/passing/refs.ocamlformat/extensions-indent.mli.ref diff --git a/test/passing/tests/extensions.ml.ref b/test/passing/refs.ocamlformat/extensions.ml.ref similarity index 98% rename from test/passing/tests/extensions.ml.ref rename to test/passing/refs.ocamlformat/extensions.ml.ref index b85bc9347a..ba13442f34 100644 --- a/test/passing/tests/extensions.ml.ref +++ b/test/passing/refs.ocamlformat/extensions.ml.ref @@ -47,8 +47,7 @@ let _ = ([%ext? (x : x)] : [%ext? (x : x)]) [%%ext 11111111111111111111] -[%%ext -11111111111111111111111 22222222222222222222222 33333333333333333333333] +[%%ext 11111111111111111111111 22222222222222222222222 33333333333333333333333] [%%ext 11111111111111111111 ;; diff --git a/test/passing/refs.ocamlformat/extensions.mli.ref b/test/passing/refs.ocamlformat/extensions.mli.ref new file mode 100644 index 0000000000..4918a2d63b --- /dev/null +++ b/test/passing/refs.ocamlformat/extensions.mli.ref @@ -0,0 +1,92 @@ +type%foo t = < .. > + +type t = + [%foooooooooo + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] +[@@foooooooooo + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%foooooooooo +fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%foooooooooo: +fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo +foooooooooooooooooooooooooooooooooo +foooooooooooooooooooooooooooo +foooooooooooooooooooooooooooo] + +[@@@foooooooooo +fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] + +[%%ext +val foooooooooooooooooooooo : fooooooooooo + +val fooooooooooooooooooooooooooo : fooooo] + +exception%ext E + +[%%ext exception E] + +include%ext M + +[%%ext include M] + +module type%ext T = M + +[%%ext module type T = M] + +module%ext T : M + +[%%ext: module T : M] + +module%ext rec T : M + +and Z : Q + +[%%ext: +module rec T : M + +and Z : Q] + +module%ext T := M + +[%%ext: module T := M] + +open%ext M +open! %ext M + +[%%ext open M] + +[%%ext open! M] + +type%foo t += T + +[%%foo: type t += T] + +val%foo x : t + +[%%foo: val x : t] + +external%foo x : t = "" + +[%%foo: external x : t = ""] + +class%foo x : t + +[%%foo: class x : t] + +class type%foo x = x + +[%%foo: class type x = x] + +type%ext t := x + +[%%ext: type t := x] diff --git a/test/passing/refs.ocamlformat/extensions_exp_grouping.ml.ref b/test/passing/refs.ocamlformat/extensions_exp_grouping.ml.ref new file mode 100644 index 0000000000..021f9921bb --- /dev/null +++ b/test/passing/refs.ocamlformat/extensions_exp_grouping.ml.ref @@ -0,0 +1,93 @@ +let _ = + begin%ext + y >>= z + end + +let _ = + [%ext + begin + y >>= z + end] + +let _ = + x + >>= begin%ext + y >>= z + end + +let _ = + x + >>= [%ext + begin + y >>= z + end] + +let _ = + f + begin%ext + y >>= z + end + +let _ = + f + [%ext + begin + y >>= z + end] + +let _ = (module%ext S) + +let _ = [%ext (module S)] + +let _ = f (module%ext S) + +let _ = f [%ext (module S)] + +let _ = (module%ext S : S) + +let _ = [%ext (module S : S)] + +let _ = f (module%ext S : S) + +let _ = f [%ext (module S : S)] + +let _ = x ;%ext y + +let _ = [%ext x ; y] + +let _ = f (x ;%ext y) + +let _ = f [%ext x ; y] + +let _ = + match w with + | (lazy%ext x) when x = y -> + k + | [%ext lazy x] when x = y -> + k + | (module%ext M) -> + k + | [%ext (module M)] -> + k + | (module%ext M : S) -> + k + | [%ext (module M : S)] -> + k + | (exception%ext e) -> + k + | ((exception%ext e) [@attr]) -> + k + | [%ext? exception e] -> + k + | _ -> + default + +let a = + (* test *) + Lwt.return () ;%lwt Lwt.return 1 + +let a = + f + ( (* test *) + Lwt.return () ;%lwt + Lwt.return 1 ) diff --git a/test/passing/tests/field-op_begin_line.ml.ref b/test/passing/refs.ocamlformat/field-op_begin_line.ml.ref similarity index 100% rename from test/passing/tests/field-op_begin_line.ml.ref rename to test/passing/refs.ocamlformat/field-op_begin_line.ml.ref diff --git a/test/passing/refs.ocamlformat/field.ml.ref b/test/passing/refs.ocamlformat/field.ml.ref new file mode 100644 index 0000000000..5ee934ccd2 --- /dev/null +++ b/test/passing/refs.ocamlformat/field.ml.ref @@ -0,0 +1,26 @@ +let foo = + entry.logdata.value_end <- + entry.logdata.value_end - !remove_size + testtesttest ; + entry.logdata.value_end <- + (entry.logdata.value_end - !remove_size + testtesttest) [@foo] ; + (* foooooooooo *) + entry.logdata.value_end <- + (entry.logdata.value_end - !remove_size + testtesttest) [@foo] + (* foooooooooooo *) ; + entry.logdata.value_end <- + entry.logdata.value_end - !remove_size + testtesttest + (* fooooooooooooooooooooooooo *) ; + value_end <- + entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest ; + value_end <- + ( entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest ) + [@foo] ; + value_end <- + ( entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest ) + [@foo] + (* fooooooooooooo *) ; + (* foooooooooooooooooooo *) + value_end <- + entry.logdata.value_end - !remove_size + testtesttesttesttesttesttest + (* foooooooo *) ; + foo diff --git a/test/passing/tests/first_class_module.ml.ref b/test/passing/refs.ocamlformat/first_class_module.ml.ref similarity index 100% rename from test/passing/tests/first_class_module.ml.ref rename to test/passing/refs.ocamlformat/first_class_module.ml.ref diff --git a/test/passing/refs.ocamlformat/floating_doc.ml.ref b/test/passing/refs.ocamlformat/floating_doc.ml.ref new file mode 100644 index 0000000000..64257a1e80 --- /dev/null +++ b/test/passing/refs.ocamlformat/floating_doc.ml.ref @@ -0,0 +1,11 @@ +type t = int + +(** Floating doc comment *) + +and u = float + +let f = () + +(** pesky doc comment *) + +and g = () diff --git a/test/passing/refs.ocamlformat/for_while.ml.ref b/test/passing/refs.ocamlformat/for_while.ml.ref new file mode 100644 index 0000000000..a66c0e6183 --- /dev/null +++ b/test/passing/refs.ocamlformat/for_while.ml.ref @@ -0,0 +1,50 @@ +let () = + foo + ( for i = 1 to 10 do + () + done ) + +let () = + foo + ( while true do + () + done ) + +let _ = + for i = some expr to 1000 do + test this + done + +let _ = + for + something_big = some big expression + to something biggggggggggggggggggggggggggggggg + do + test this + done + +let _ = + for + something_big = some big expressionnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn + to something biggggggggggggggggggggggggggggggg + alsooooooooooooooooooooooooooooooooooooooooooo + do + test this + done + +let _ = + for + something_big = some big expressionnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn + downto something biggggggggggggggggggggggggggggggg + alsooooooooooooooooooooooooooooooooooooooooooo + do + test this + done + +let _ = + while + some bigggggggggggggggggggggg + expressionnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn + do + test this + done diff --git a/test/passing/tests/fun_decl-no-wrap-fun-args.ml.ref b/test/passing/refs.ocamlformat/fun_decl-no-wrap-fun-args.ml.ref similarity index 82% rename from test/passing/tests/fun_decl-no-wrap-fun-args.ml.ref rename to test/passing/refs.ocamlformat/fun_decl-no-wrap-fun-args.ml.ref index ba9f5d6bc8..c6bc54e528 100644 --- a/test/passing/tests/fun_decl-no-wrap-fun-args.ml.ref +++ b/test/passing/refs.ocamlformat/fun_decl-no-wrap-fun-args.ml.ref @@ -44,11 +44,8 @@ let to_loc_trace ?(desc_of_sink = fun sink -> let callsite = Sink.call_site sink in - Format.asprintf - "call to %a" - Typ.Procname.pp - (CallSite.pname callsite)) ?(sink_should_nest = fun _ -> true) - (passthroughs, sources, sinks) = + Format.asprintf "call to %a" Typ.Procname.pp (CallSite.pname callsite)) + ?(sink_should_nest = fun _ -> true) (passthroughs, sources, sinks) = () let translate_captured @@ -59,19 +56,22 @@ let translate_captured () let f ssssssssss = - String.fold - ssssssssss - ~init:innnnnnnnnnit - ~f:(fun accuuuuuuuuuum -> function - | '0' -> g accuuuuuuuuuum - | '1' -> h accuuuuuuuuuum - | _ -> i accuuuuuuuuuum ) + String.fold ssssssssss ~init:innnnnnnnnnit ~f:(fun accuuuuuuuuuum -> function + | '0' -> + g accuuuuuuuuuum + | '1' -> + h accuuuuuuuuuum + | _ -> + i accuuuuuuuuuum ) let f ssssssssss = String.fold ssssssssss ~init:innnnnnnnnnit ~f:(function - | '0' -> g accuuuuuuuuuum - | '1' -> h accuuuuuuuuuum - | _ -> i accuuuuuuuuuum ) + | '0' -> + g accuuuuuuuuuum + | '1' -> + h accuuuuuuuuuum + | _ -> + i accuuuuuuuuuum ) let f _ = let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in @@ -113,5 +113,6 @@ class traverse_labels h = | Labelled_statement (L l, (s, _)) -> let m = {<ldepth = ldepth + 1>} in Hashtbl.add h l ldepth ; m#statement s - | s -> super#statement s + | s -> + super#statement s end diff --git a/test/passing/tests/fun_decl.ml.ref b/test/passing/refs.ocamlformat/fun_decl.ml.ref similarity index 82% rename from test/passing/tests/fun_decl.ml.ref rename to test/passing/refs.ocamlformat/fun_decl.ml.ref index 195236bf9c..085bd16e8d 100644 --- a/test/passing/tests/fun_decl.ml.ref +++ b/test/passing/refs.ocamlformat/fun_decl.ml.ref @@ -30,9 +30,8 @@ let to_loc_trace ?(desc_of_sink = fun sink -> let callsite = Sink.call_site sink in - Format.asprintf "call to %a" Typ.Procname.pp - (CallSite.pname callsite)) ?(sink_should_nest = fun _ -> true) - (passthroughs, sources, sinks) = + Format.asprintf "call to %a" Typ.Procname.pp (CallSite.pname callsite)) + ?(sink_should_nest = fun _ -> true) (passthroughs, sources, sinks) = () let translate_captured @@ -43,17 +42,22 @@ let translate_captured () let f ssssssssss = - String.fold ssssssssss ~init:innnnnnnnnnit - ~f:(fun accuuuuuuuuuum -> function - | '0' -> g accuuuuuuuuuum - | '1' -> h accuuuuuuuuuum - | _ -> i accuuuuuuuuuum ) + String.fold ssssssssss ~init:innnnnnnnnnit ~f:(fun accuuuuuuuuuum -> function + | '0' -> + g accuuuuuuuuuum + | '1' -> + h accuuuuuuuuuum + | _ -> + i accuuuuuuuuuum ) let f ssssssssss = String.fold ssssssssss ~init:innnnnnnnnnit ~f:(function - | '0' -> g accuuuuuuuuuum - | '1' -> h accuuuuuuuuuum - | _ -> i accuuuuuuuuuum ) + | '0' -> + g accuuuuuuuuuum + | '1' -> + h accuuuuuuuuuum + | _ -> + i accuuuuuuuuuum ) let f _ = let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in @@ -94,5 +98,6 @@ class traverse_labels h = | Labelled_statement (L l, (s, _)) -> let m = {<ldepth = ldepth + 1>} in Hashtbl.add h l ldepth ; m#statement s - | s -> super#statement s + | s -> + super#statement s end diff --git a/test/passing/refs.ocamlformat/fun_function.ml.ref b/test/passing/refs.ocamlformat/fun_function.ml.ref new file mode 100644 index 0000000000..7593c3dc3b --- /dev/null +++ b/test/passing/refs.ocamlformat/fun_function.ml.ref @@ -0,0 +1,131 @@ +let s = + List.fold x ~f:(fun y -> function + | Aconstructor avalue -> + afunction avalue + | Bconstructor bvalue -> + bfunction bvalue ) + +let f _ = (function x -> x + 1) + +let f _ = function x -> x + 1 + +let f _ = fun _ -> (function x -> x + 1) + +let f _ = fun _ -> function x -> x + 1 + +let f _ = fun _ -> (function x -> x + 1) + +let f _ = fun _ -> function x -> x + 1 + +let f _ = fun _ -> fun x -> x + 1 + +let f _ = fun _ -> fun x -> x + 1 + +let f _ = fun _ -> fun x -> x + 1 + +let f _ = fun _ -> fun x -> x + 1 + +let _ = + let f _ = (function x -> x + 1) in + () + +let _ = + let f _ = function x -> x + 1 in + () + +let _ = + let f _ = fun _ -> (function x -> x + 1) in + () + +let _ = + let f _ = fun _ -> function x -> x + 1 in + () + +let _ = + let f _ = fun _ -> (function x -> x + 1) in + () + +let _ = + let f _ = fun _ -> function x -> x + 1 in + () + +let _ = + let f _ = fun _ -> fun x -> x + 1 in + () + +let _ = + let f _ = fun _ -> fun x -> x + 1 in + () + +let _ = + let f _ = fun _ -> fun x -> x + 1 in + () + +let _ = + let f _ = fun _ -> fun x -> x + 1 in + () + +class c = + let f _ = (function x -> x + 1) in + object end + +class c = + let f _ = function x -> x + 1 in + object end + +class c = + let f _ = fun _ -> (function x -> x + 1) in + object end + +class c = + let f _ = fun _ -> function x -> x + 1 in + object end + +class c = + let f _ = fun _ -> (function x -> x + 1) in + object end + +class c = + let f _ = fun _ -> function x -> x + 1 in + object end + +class c = + let f _ = fun _ -> fun x -> x + 1 in + object end + +class c = + let f _ = fun _ -> fun x -> x + 1 in + object end + +class c = + let f _ = fun _ -> fun x -> x + 1 in + object end + +class c = + let f _ = fun _ -> fun x -> x + 1 in + object end + +open struct + [@@@ocamlformat "let-binding-deindent-fun=true"] + + let _ = + let _ = function + | Partial _ -> ( + fun {target} -> + match target with + | Lazy key -> + Val_ref.of_key key + | Lazy_loaded {v_ref; _} | Dirty {v_ref; _} -> + v_ref ) + in + () + + let _ = function + | Partial _ -> ( + fun {target} -> + match target with + | Lazy key -> + Val_ref.of_key key + | Lazy_loaded {v_ref; _} | Dirty {v_ref; _} -> + v_ref ) +end diff --git a/test/passing/refs.ocamlformat/function_indent-never.ml.ref b/test/passing/refs.ocamlformat/function_indent-never.ml.ref new file mode 100644 index 0000000000..1c635fac3a --- /dev/null +++ b/test/passing/refs.ocamlformat/function_indent-never.ml.ref @@ -0,0 +1,55 @@ +let foooooooo = function + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + +let foooooooo = function + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + +let foo = + fooooooooo foooooooo ~foooooooo:(function + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo ) + +let foo = + fooooooooo foooooooo foooooooo foooooooo foooooooo foooooooo + ~foooooooo:(function + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo ) + +let foooooooo = + if fooooooooooo then function + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + else function + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + +let _ = + { foo= + (fun _ -> function + | _ -> + let _ = 42 in + () + | () -> + () ) } + +let _ = + match () with + | _ -> ( + f + >>= function + | `Fooooooooooooooooooooooooooooooooooooooo -> + 1 + | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> + 2 ) diff --git a/test/passing/refs.ocamlformat/function_indent.ml.ref b/test/passing/refs.ocamlformat/function_indent.ml.ref new file mode 100644 index 0000000000..616b5eccbe --- /dev/null +++ b/test/passing/refs.ocamlformat/function_indent.ml.ref @@ -0,0 +1,55 @@ +let foooooooo = function + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + +let foooooooo = function + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + +let foo = + fooooooooo foooooooo ~foooooooo:(function + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo ) + +let foo = + fooooooooo foooooooo foooooooo foooooooo foooooooo foooooooo + ~foooooooo:(function + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo ) + +let foooooooo = + if fooooooooooo then function + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + else function + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + +let _ = + { foo= + (fun _ -> function + | _ -> + let _ = 42 in + () + | () -> + () ) } + +let _ = + match () with + | _ -> ( + f + >>= function + | `Fooooooooooooooooooooooooooooooooooooooo -> + 1 + | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> + 2 ) diff --git a/test/passing/refs.ocamlformat/functor.ml.err b/test/passing/refs.ocamlformat/functor.ml.err new file mode 100644 index 0000000000..22e08d5830 --- /dev/null +++ b/test/passing/refs.ocamlformat/functor.ml.err @@ -0,0 +1,2 @@ +Warning: functor.ml:72 exceeds the margin +Warning: functor.ml:87 exceeds the margin diff --git a/test/passing/tests/functor.ml.ref b/test/passing/refs.ocamlformat/functor.ml.ref similarity index 92% rename from test/passing/tests/functor.ml.ref rename to test/passing/refs.ocamlformat/functor.ml.ref index 0460432faf..d98f73ccb7 100644 --- a/test/passing/tests/functor.ml.ref +++ b/test/passing/refs.ocamlformat/functor.ml.ref @@ -70,8 +70,7 @@ module type KV_MAKER = functor (G : Irmin_git.G) (C : Irmin.Contents.S) -> module Make (TT : TableFormat.TABLES) - (IT : - InspectionTableFormat.TABLES__________________________________________) + (IT : InspectionTableFormat.TABLES__________________________________________) (ET : EngineTypes.TABLE with type terminal = int @@ -86,8 +85,7 @@ end module Make (TT : TableFormat.TABLES) - (IT : - InspectionTableFormat.TABLES__________________________________________) = + (IT : InspectionTableFormat.TABLES__________________________________________) = struct type t = t end diff --git a/test/passing/refs.ocamlformat/functor.mli.ref b/test/passing/refs.ocamlformat/functor.mli.ref new file mode 100644 index 0000000000..a2ae6a583a --- /dev/null +++ b/test/passing/refs.ocamlformat/functor.mli.ref @@ -0,0 +1,3 @@ +module F (* test *) (M : sig + type t +end) : S diff --git a/test/passing/refs.ocamlformat/funsig.ml.ref b/test/passing/refs.ocamlformat/funsig.ml.ref new file mode 100644 index 0000000000..fff4716c44 --- /dev/null +++ b/test/passing/refs.ocamlformat/funsig.ml.ref @@ -0,0 +1,70 @@ +val fffffffff : aaaaaa -> bbbbbbbbbb ccccccccc -> dddd + +val fffffffff : aaaaaa -> bbbbbbbbbb ccccccccc -> dddd -> dddd -> dddd -> dddd + +val fffffffff : + aaaaaa -> (bbbbbbbbbb ccccccccc -> int) -> bbbbbbbbbb ccccccccc -> dddd + +val fffffffff : + eeee:('a, 'b) aaaaaa + -> (bbbbbbbbbb ccccccccc -> int) + -> bbbbbbbbbb ccccccccc + -> dddd + -> dddd + +val m : (module S with type t = t) + +val f : + ( 'aaaaaaaaaaaaaaaaaaaa + , xxxxxxxxxxxxxxxxxxxxxxxxx + -> yyyyyyyyyyyyyyyyyyyyyyyyy + -> bbbbbbbbbbbbbbbbbbbb + , 'dddddddddddddddddddd ) + s + +type t = + | Cstr of + ( xxxxxxxxxxxxxxxxxxxxxxxxx + -> yyyyyyyyyyyyyyyyyyyyyyyyy + -> aaaaaaaaaaaaaaaaaaaa ) + * bbbbbbbbbbbbbbbbbbbb + +type t = + | Cstr of + aaaaaaaaaaaaaaaaaaaa + * ( xxxxxxxxxxxxxxxxxxxxxxxxx + -> yyyyyyyyyyyyyyyyyyyyyyyyy + -> bbbbbbbbbbbbbbbbbbbb ) + * cccccccccccccccccccc + +type ('aaaa, 'bbbb, 'cccc) t = + llll:('aaaa, 'bbbb, 'cccc) s -> dddddd list -> 'aaaa * 'cccc -> 'bbbb uuuuu + +external ident : a -> b -> c -> d = "something" + +external ident : a -> b -> c -> d = "something" "else" + +val ident : a -> b -> c -> d + +val ident : arg1_is_loooooooooooooooooooooooooooooooong -> arg2 -> arg3 -> arg4 + +external ident : + arg1_is_loooooooooooooooooooooooooooooooong -> arg2 -> arg3 -> arg4 + = "something" "else" + +type t = {field1: a -> b -> c; field2: int; field3: a -> b -> c -> d -> e} + +type t = {field1: a -> b -> c; field2: int; field3: a -> b -> c -> d -> e -> f} + +type t = + { field1: a -> b -> c + ; field2: int + ; field3: + a_is_loooooooooooooooooooooooooooooooong + -> b_is_loooooooooooooooooooooooooooooooong + -> c + -> d + -> e + ; field4: a_is_loooooooooooooooooooong -> b_is_loooooooooong -> c -> d -> e + ; field5: + a loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong typ } diff --git a/test/passing/refs.ocamlformat/gadt.ml.ref b/test/passing/refs.ocamlformat/gadt.ml.ref new file mode 100644 index 0000000000..b9a3d76dad --- /dev/null +++ b/test/passing/refs.ocamlformat/gadt.ml.ref @@ -0,0 +1,19 @@ +type t = A : t + +type t = A : t * 'b -> t + +type (_, _, _, _, _) gadt = + | SomeLongName : + ('a, 'b, long_name * long_name2, 't, 'u) gadt * ('b, 'c, 'v, 'u, 'k) gadt2 + -> ('a, 'c, long_name * 'k, 't, 'v) gadt + | AnEvenLongerName : + ('a, 'b, long_name * long_name2, 't, 'u) gadt * ('b, 'c, 'v, 'u, 'k) gadt2 + -> ('a, 'c, long_name * 'k, 't, 'v) gadt + +type _ t = .. + +type _ t += A : int | B : int -> int + +type t = A : (int -> int) -> int + +type _ g = MkG : 'a. 'a g diff --git a/test/passing/tests/generative.ml.ref b/test/passing/refs.ocamlformat/generative.ml.ref similarity index 100% rename from test/passing/tests/generative.ml.ref rename to test/passing/refs.ocamlformat/generative.ml.ref diff --git a/test/passing/refs.ocamlformat/hash_bang.ml.ref b/test/passing/refs.ocamlformat/hash_bang.ml.ref new file mode 100644 index 0000000000..c5284310b4 --- /dev/null +++ b/test/passing/refs.ocamlformat/hash_bang.ml.ref @@ -0,0 +1,3 @@ +#!/usr/bin/env ocaml + +let _ = sprintf "[%s]" s diff --git a/test/passing/refs.ocamlformat/hash_types.ml.ref b/test/passing/refs.ocamlformat/hash_types.ml.ref new file mode 100644 index 0000000000..a2f551ab00 --- /dev/null +++ b/test/passing/refs.ocamlformat/hash_types.ml.ref @@ -0,0 +1,13 @@ +module F (X : sig + type t +end) = +struct + class type ['a] c = object + method m : 'a -> X.t + end +end + +class ['a] c = + object + constraint 'a = 'a #F(Int).c + end diff --git a/test/passing/refs.ocamlformat/holes.ml.ref b/test/passing/refs.ocamlformat/holes.ml.ref new file mode 100644 index 0000000000..27d14d6151 --- /dev/null +++ b/test/passing/refs.ocamlformat/holes.ml.ref @@ -0,0 +1,11 @@ +let () = _ + +(** doc *) +let () = (* A *) _ (* B *) [@attr] (* C *) + +module M = _ + +(** doc *) +module M = (* A *) _ (* B *) [@attr] (* C *) + +module M = _ (_) (_) diff --git a/test/passing/refs.ocamlformat/ifand.ml.ref b/test/passing/refs.ocamlformat/ifand.ml.ref new file mode 100644 index 0000000000..62c595ad79 --- /dev/null +++ b/test/passing/refs.ocamlformat/ifand.ml.ref @@ -0,0 +1,3 @@ +let _ = if cond1 && cond2 then _ + +let _ = function _ when x = 2 && y = 3 -> if a = b || (b = c && c = d) then _ diff --git a/test/passing/refs.ocamlformat/index_op.ml.ref b/test/passing/refs.ocamlformat/index_op.ml.ref new file mode 100644 index 0000000000..6aea385bda --- /dev/null +++ b/test/passing/refs.ocamlformat/index_op.ml.ref @@ -0,0 +1,207 @@ +let ( .?[] ) = Hashtbl.find_opt + +let ( .@[] ) = Hashtbl.find + +let ( .@[]<- ) = Hashtbl.add + +let ( .@{} ) = Hashtbl.find + +let ( .@{}<- ) = Hashtbl.add + +let ( .@() ) = Hashtbl.find + +let ( .@()<- ) = Hashtbl.add + +let h = Hashtbl.create 17 ;; + +h.@("One") <- 1 ; +assert (h.@{"One"} = 1) ; +print_int h.@{"One"} ; +assert (h.?["Two"] = None) + +(* from GPR#1392 *) +let ( #? ) x y = (x, y) + +let ( .%() ) x y = x.(y) + +let x = [|0|] + +let _ = 1#?x.(0) + +let _ = 1#?x.%(0) ;; + +a.[b].[c] ;; + +a.[b.[c]].[c] ;; + +a.b.c + +let _ = s.{1} + +let _ = s.{1} <- 1 + +let _ = s.{1, 2} + +let _ = s.{1, 2} <- 1 + +let _ = s.{1, 2, 3} + +let _ = s.{1, 2, 3} <- 1 + +let _ = s.{1, 2, 3, 4} + +let _ = s.{1, 2, 3, 4} <- 1 + +let _ = Bigarray.Genarray.get s 1 [||] + +let _ = Bigarray.Genarray.get s [|1|] + +let _ = Bigarray.Genarray.get s [|1; 2|] + +let _ = Bigarray.Genarray.get s [|1; 2; 3|] + +let _ = s.{1, 2, 3, 4} + +let _ = Bigarray.Genarray.set s [||] 1 + +let _ = Bigarray.Genarray.set s [|1|] 1 + +let _ = Bigarray.Genarray.set s [|1; 2|] 1 + +let _ = Bigarray.Genarray.set s [|1; 2; 3|] 1 + +let _ = s.{1, 2, 3, 4} <- 1 + +let () = + let m = Mat.zeros 5 5 in + m.Mat.${[[2]; [5]]} |> ignore ; + let open Mat in + m.${[[2]; [5]]} |> ignore + +let _ = (x.*{y, z} <- w) @ [] + +let _ = (x.{y, z} <- w) @ [] + +let _ = (x.*(y) <- z) @ [] + +let _ = (x.*(y) <- z) := [] + +let _ = ((x.*(y) <- z), []) + +let _ = + x.*(y) <- z ; + [] + +let _ = (x.(y) <- z) @ [] + +let _ = (x.(y) <- z) := [] + +let _ = ((x.(y) <- z), []) + +let _ = + x.(y) <- z ; + [] + +let _ = (x.y <- z) @ [] + +let _ = (x.y <- z) := [] + +let _ = ((x.y <- z), []) + +let _ = + x.y <- z ; + [] + +let _ = x.(y) <- (z.(w) <- u) + +let _ = x.foo#m + +class free = + object (m : 'test) + method get_def = m#state.def + end + +(* With path *) +let _ = + a.A.B.*(b) ; + a.A.B.*(b) <- c + +let _ = a.*((a ; b)) + +let _ = a.*([|a; b|]) + +(* Avoid unecessary parentheses *) +let _ = + match a with + | A -> + a.*(match b with B -> b) + | B -> + a.*(match b with B -> b) <- D + | C -> + () + +let _ = if a then a.*(if a then b) else c + +(* Parentheses needed *) +let _ = a.*{(a ; b)} + +let _ = a.{a ; b} + +let _ = a.{a, b} + +(* Integers on the left of indexing operators must be surrounded by + parentheses *) +let _ = (0).*(0) + +(* Integers with suffix and floats are fine *) +let _ = 0l.*(0) + +let _ = 0..*(0) + +let _ = 0.2.*(0) + +let _ = 2e5.*(0) + +let _ = 2e-2.*(0) + +let _ = (String.get [@bar]) filename (len - 1) = 'i' + +let _ = "hello world".[-8] + +let _ = String.get "hello world" (-8) + +let _ = String.unsafe_get "hello world" (-8) + +let _ = [||].(-8) + +let _ = Array.get [||] (-8) + +let _ = Array.unsafe_get [||] (-8) + +let _ = Bigarray.Genarray.get x [||] (-8) + +let _ = Bigarray.Genarray.unsafe_get x [||] (-8) + +let _ = [%p (Some).(tickers)] + +let _ = [%p (Explicit).(0 / 2)] + +let _ = [%p Some.(tickers)] + +let _ = [%p Explicit.(0 / 2)] + +let _ = (Some).(tickers) + +let _ = (Explicit).(0 / 2) + +let _ = Some.(tickers) + +let _ = Explicit.(0 / 2) + +let _ = f (Some).(tickers) + +let _ = f (Explicit).(0 / 2) + +let _ = f Some.(tickers) + +let _ = f Explicit.(0 / 2) diff --git a/test/passing/tests/indicate_multiline_delimiters-cosl.ml.ref b/test/passing/refs.ocamlformat/indicate_multiline_delimiters-cosl.ml.ref similarity index 72% rename from test/passing/tests/indicate_multiline_delimiters-cosl.ml.ref rename to test/passing/refs.ocamlformat/indicate_multiline_delimiters-cosl.ml.ref index 764a7fa7a1..abf6a2c59a 100644 --- a/test/passing/tests/indicate_multiline_delimiters-cosl.ml.ref +++ b/test/passing/refs.ocamlformat/indicate_multiline_delimiters-cosl.ml.ref @@ -1,17 +1,21 @@ let compare = function - | Eq -> ( = ) - | Neq -> ( <> ) - | Lt -> ( < ) [@attr] - | Le -> ( <= ) - | Gt -> ( > ) - | Ge -> ( >= ) + | Eq -> + ( = ) + | Neq -> + ( <> ) + | Lt -> + ( < ) [@attr] + | Le -> + ( <= ) + | Gt -> + ( > ) + | Ge -> + ( >= ) let raise fmt = Fmt.kstr (fun error_message (result : _ result) -> - match result with - | Ok v -> v - | Error `Oh_no -> invalid_arg error_message + match result with Ok v -> v | Error `Oh_no -> invalid_arg error_message ) fmt @@ -25,9 +29,7 @@ let raise fmt = let raise fmt = Fmt.kstr (fun error_message (result : _ result) -> - match result with - | Ok v -> v - | Error `Oh_no -> invalid_arg error_message + match result with Ok v -> v | Error `Oh_no -> invalid_arg error_message ) fmt @@ -52,10 +54,11 @@ let contrived = let x = match y with - | Empty | Leaf _ -> assert false + | Empty | Leaf _ -> + assert false | Node - ( {left= lr_left; key= _; value= fooooooo; height= _; right= lr_right} - as lr_node + ( {left= lr_left; key= _; value= fooooooo; height= _; right= lr_right} as + lr_node ) -> left_node.right <- lr_left ; root_node.left <- lr_right ; diff --git a/test/passing/tests/indicate_multiline_delimiters-space.ml.ref b/test/passing/refs.ocamlformat/indicate_multiline_delimiters-space.ml.ref similarity index 71% rename from test/passing/tests/indicate_multiline_delimiters-space.ml.ref rename to test/passing/refs.ocamlformat/indicate_multiline_delimiters-space.ml.ref index b8a491787a..4004b8a0f2 100644 --- a/test/passing/tests/indicate_multiline_delimiters-space.ml.ref +++ b/test/passing/refs.ocamlformat/indicate_multiline_delimiters-space.ml.ref @@ -1,17 +1,21 @@ let compare = function - | Eq -> ( = ) - | Neq -> ( <> ) - | Lt -> ( < ) [@attr] - | Le -> ( <= ) - | Gt -> ( > ) - | Ge -> ( >= ) + | Eq -> + ( = ) + | Neq -> + ( <> ) + | Lt -> + ( < ) [@attr] + | Le -> + ( <= ) + | Gt -> + ( > ) + | Ge -> + ( >= ) let raise fmt = Fmt.kstr (fun error_message (result : _ result) -> - match result with - | Ok v -> v - | Error `Oh_no -> invalid_arg error_message ) + match result with Ok v -> v | Error `Oh_no -> invalid_arg error_message ) fmt let raise fmt = @@ -23,9 +27,7 @@ let raise fmt = let raise fmt = Fmt.kstr (fun error_message (result : _ result) -> - match result with - | Ok v -> v - | Error `Oh_no -> invalid_arg error_message ) + match result with Ok v -> v | Error `Oh_no -> invalid_arg error_message ) fmt let raise fmt = @@ -46,10 +48,11 @@ let contrived = let x = match y with - | Empty | Leaf _ -> assert false + | Empty | Leaf _ -> + assert false | Node - ( {left= lr_left; key= _; value= fooooooo; height= _; right= lr_right} - as lr_node ) -> + ( {left= lr_left; key= _; value= fooooooo; height= _; right= lr_right} as + lr_node ) -> left_node.right <- lr_left ; root_node.left <- lr_right ; lr_node.right <- tree diff --git a/test/passing/refs.ocamlformat/indicate_multiline_delimiters.ml.ref b/test/passing/refs.ocamlformat/indicate_multiline_delimiters.ml.ref new file mode 100644 index 0000000000..f3ab2e9506 --- /dev/null +++ b/test/passing/refs.ocamlformat/indicate_multiline_delimiters.ml.ref @@ -0,0 +1,58 @@ +let compare = function + | Eq -> + ( = ) + | Neq -> + ( <> ) + | Lt -> + ( < ) [@attr] + | Le -> + ( <= ) + | Gt -> + ( > ) + | Ge -> + ( >= ) + +let raise fmt = + Fmt.kstr + (fun error_message (result : _ result) -> + match result with Ok v -> v | Error `Oh_no -> invalid_arg error_message) + fmt + +let raise fmt = + Fmt.kstr + (fun error_message aaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb -> + invalid_arg error_message) + fmt + +let raise fmt = + Fmt.kstr + (fun error_message (result : _ result) -> + match result with Ok v -> v | Error `Oh_no -> invalid_arg error_message) + fmt + +let raise fmt = + Fmt.kstr + (fun error_message aaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb -> + invalid_arg error_message) + fmt + +let contrived = + List.map + ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) + l + +let contrived = + List.map l ~f:(fun aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -> + f aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) + +let x = + match y with + | Empty | Leaf _ -> + assert false + | Node + ({left= lr_left; key= _; value= fooooooo; height= _; right= lr_right} as + lr_node) -> + left_node.right <- lr_left ; + root_node.left <- lr_right ; + lr_node.right <- tree diff --git a/test/passing/tests/infix_arg_grouping.ml.ref b/test/passing/refs.ocamlformat/infix_arg_grouping.ml.ref similarity index 89% rename from test/passing/tests/infix_arg_grouping.ml.ref rename to test/passing/refs.ocamlformat/infix_arg_grouping.ml.ref index aa71b47d83..d1157ddec1 100644 --- a/test/passing/tests/infix_arg_grouping.ml.ref +++ b/test/passing/refs.ocamlformat/infix_arg_grouping.ml.ref @@ -1,7 +1,6 @@ vbox 1 ( str (Sexp.to_string_hum (Itv.sexp_of_t root)) - $ wrap_if (not (List.is_empty children)) "@,{" " }" (dump_ tree children) - ) + $ wrap_if (not (List.is_empty children)) "@,{" " }" (dump_ tree children) ) ;; user_error @@ -20,9 +19,12 @@ hvbox 1 $ opt next (fun next -> let spc = match String.lfindi next ~f:(fun _ c -> not (drop c)) with - | Some 0 -> "" - | Some i -> escape_string (String.sub next 0 i) - | None -> escape_string next + | Some 0 -> + "" + | Some i -> + escape_string (String.sub next 0 i) + | None -> + escape_string next in fmt "\\n" $ fmt_if_k @@ -46,7 +48,8 @@ hvbox 0 $ fmt_core_type c (sub_typ ~ctx typ) ) $ fmt_docstring c ~pro:(fmt "@;<2 0>") doc $ fmt_attributes c (fmt " ") ~key:"@" atrs (fmt "") ) - | Oinherit typ -> fmt_core_type c (sub_typ ~ctx typ) ) + | Oinherit typ -> + fmt_core_type c (sub_typ ~ctx typ) ) $ fmt_if Poly.(closedness = Open) (match fields with [] -> "@ .. " | _ -> "@ ; .. ") ) ) @@ -70,9 +73,7 @@ let to_json {integers; floats; strings} = |> Yojson.Basic.to_string let rename (us, q) sub = - ( Var.Set.union - (Var.Set.diff us (Var.Subst.domain sub)) - (Var.Subst.range sub) + ( Var.Set.union (Var.Set.diff us (Var.Subst.domain sub)) (Var.Subst.range sub) , rename_q q sub ) |> check invariant @@ -97,7 +98,8 @@ match (* split by whitespace *) Str.split (Str.regexp_string "\" \"") with -| prog :: args -> fooooooooooooooooooooo +| prog :: args -> + fooooooooooooooooooooo let () = (* Open the repo *) diff --git a/test/passing/tests/infix_bind-break.ml.ref b/test/passing/refs.ocamlformat/infix_bind-break.ml.ref similarity index 91% rename from test/passing/tests/infix_bind-break.ml.ref rename to test/passing/refs.ocamlformat/infix_bind-break.ml.ref index fd74ad8e83..909450b26d 100644 --- a/test/passing/tests/infix_bind-break.ml.ref +++ b/test/passing/refs.ocamlformat/infix_bind-break.ml.ref @@ -77,8 +77,7 @@ eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x ;; -eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function xxxxxxxxx, xxxxxxxxxxxxx -> x -;; +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function xxxxxxxxx, xxxxxxxxxxxxx -> x ;; eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee |> function xxxxxxxx, xxxxxxxxx, xxxxxxxxxxxxx -> x @@ -101,8 +100,7 @@ let parens = fmt "@ " $ Cmts.fmt c.cmts pexp_loc (wrap_if parens "(" ")" - ( fmt "function" - $ fmt_extension_suffix c ext + ( fmt "function" $ fmt_extension_suffix c ext $ fmt_attributes c ~key:"@" pexp_attributes $ close_box $ fmt "@ " $ fmt_cases c ctx cs ) ) | _ -> @@ -117,16 +115,15 @@ let parens = fmt "@ " $ Cmts.fmt c.cmts pexp_loc (wrap_if parens "(" ")" - ( fmt "function" - $ fmt_extension_suffix c ext + ( fmt "function" $ fmt_extension_suffix c ext $ fmt_attributes c ~key:"@" pexp_attributes $ close_box $ fmt "@ " $ fmt_cases c ctx cs ) ) | _ -> - close_box $ fmt "@ " - $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody ) + close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody + ) -let end_gen_implementation ?toplevel ~ppf_dump - (clambda : clambda_and_constants) = +let end_gen_implementation ?toplevel ~ppf_dump (clambda : clambda_and_constants) + = Emit.begin_assembly () ; ( clambda ++ Profile.record "cmm" (Cmmgen.compunit ~ppf_dump) @@ -138,7 +135,8 @@ let foo = (* get the tree origin *) get_store_tree s >>= function - | None -> f t >|= fun x -> Ok x (* no transaction is needed *) + | None -> + f t >|= fun x -> Ok x (* no transaction is needed *) | Some (origin, old_tree) -> let batch = {repo; tree= old_tree; origin} in let b = Batch batch in @@ -149,8 +147,10 @@ let _ = foo >>= function[@warning "-4"] A -> false | B -> true let _ = foo >>= function[@warning "-4"] - | Afoooooooooooooooooo fooooooooo -> false - | Bfoooooooooooooooooooooo fooooooooo -> true + | Afoooooooooooooooooo fooooooooo -> + false + | Bfoooooooooooooooooooooo fooooooooo -> + true let _ = foo >>= fun [@warning "-4"] x -> fooooooooooooooooooooooo @@ -163,8 +163,10 @@ let _ = let _ = foo >>= function(* foo before *) [@warning "-4"] (* foo after *) - | Afoooooooooooooooooo fooooooooo -> false - | Bfoooooooooooooooooooooo fooooooooo -> true + | Afoooooooooooooooooo fooooooooo -> + false + | Bfoooooooooooooooooooooo fooooooooo -> + true let _ = foo diff --git a/test/passing/tests/infix_bind-fit_or_vertical-break.ml.ref b/test/passing/refs.ocamlformat/infix_bind-fit_or_vertical-break.ml.ref similarity index 93% rename from test/passing/tests/infix_bind-fit_or_vertical-break.ml.ref rename to test/passing/refs.ocamlformat/infix_bind-fit_or_vertical-break.ml.ref index 7037020d0e..984a74eafe 100644 --- a/test/passing/tests/infix_bind-fit_or_vertical-break.ml.ref +++ b/test/passing/refs.ocamlformat/infix_bind-fit_or_vertical-break.ml.ref @@ -77,8 +77,7 @@ eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x ;; -eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function xxxxxxxxx, xxxxxxxxxxxxx -> x -;; +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function xxxxxxxxx, xxxxxxxxxxxxx -> x ;; eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee |> function xxxxxxxx, xxxxxxxxx, xxxxxxxxxxxxx -> x @@ -126,12 +125,11 @@ let parens = $ fmt "@ " $ fmt_cases c ctx cs ) ) | _ -> - close_box - $ fmt "@ " - $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody ) + close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody + ) -let end_gen_implementation ?toplevel ~ppf_dump - (clambda : clambda_and_constants) = +let end_gen_implementation ?toplevel ~ppf_dump (clambda : clambda_and_constants) + = Emit.begin_assembly () ; ( clambda ++ Profile.record "cmm" (Cmmgen.compunit ~ppf_dump) @@ -143,7 +141,8 @@ let foo = (* get the tree origin *) get_store_tree s >>= function - | None -> f t >|= fun x -> Ok x (* no transaction is needed *) + | None -> + f t >|= fun x -> Ok x (* no transaction is needed *) | Some (origin, old_tree) -> let batch = {repo; tree= old_tree; origin} in let b = Batch batch in @@ -154,8 +153,10 @@ let _ = foo >>= function[@warning "-4"] A -> false | B -> true let _ = foo >>= function[@warning "-4"] - | Afoooooooooooooooooo fooooooooo -> false - | Bfoooooooooooooooooooooo fooooooooo -> true + | Afoooooooooooooooooo fooooooooo -> + false + | Bfoooooooooooooooooooooo fooooooooo -> + true let _ = foo >>= fun [@warning "-4"] x -> fooooooooooooooooooooooo @@ -168,8 +169,10 @@ let _ = let _ = foo >>= function(* foo before *) [@warning "-4"] (* foo after *) - | Afoooooooooooooooooo fooooooooo -> false - | Bfoooooooooooooooooooooo fooooooooo -> true + | Afoooooooooooooooooo fooooooooo -> + false + | Bfoooooooooooooooooooooo fooooooooo -> + true let _ = foo diff --git a/test/passing/tests/infix_bind-fit_or_vertical.ml.ref b/test/passing/refs.ocamlformat/infix_bind-fit_or_vertical.ml.ref similarity index 87% rename from test/passing/tests/infix_bind-fit_or_vertical.ml.ref rename to test/passing/refs.ocamlformat/infix_bind-fit_or_vertical.ml.ref index 371d5cba87..a1cd6ccc6e 100644 --- a/test/passing/tests/infix_bind-fit_or_vertical.ml.ref +++ b/test/passing/refs.ocamlformat/infix_bind-fit_or_vertical.ml.ref @@ -57,13 +57,15 @@ xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function x -> x ;; eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function -| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> + x ;; eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee eeeeeeeeeeee eeeeeeeeee |> function -| x -> x +| x -> + x ;; eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee @@ -76,18 +78,20 @@ eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function x -> x ;; eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function -| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> x +| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> + x ;; -eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function xxxxxxxxx, xxxxxxxxxxxxx -> x -;; +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function xxxxxxxxx, xxxxxxxxxxxxx -> x ;; eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee |> function -| xxxxxxxx, xxxxxxxxx, xxxxxxxxxxxxx -> x +| xxxxxxxx, xxxxxxxxx, xxxxxxxxxxxxx -> + x ;; eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function -| xxxxxxxxxxxxx -> xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +| xxxxxxxxxxxxx -> + xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx ;; eeeeeeeeeeeee eeeeeeeeee |> function @@ -125,12 +129,11 @@ let parens = $ fmt "@ " $ fmt_cases c ctx cs ) ) | _ -> - close_box - $ fmt "@ " - $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody ) + close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody + ) -let end_gen_implementation ?toplevel ~ppf_dump - (clambda : clambda_and_constants) = +let end_gen_implementation ?toplevel ~ppf_dump (clambda : clambda_and_constants) + = Emit.begin_assembly () ; ( clambda ++ Profile.record "cmm" (Cmmgen.compunit ~ppf_dump) @@ -141,7 +144,8 @@ let end_gen_implementation ?toplevel ~ppf_dump let foo = (* get the tree origin *) get_store_tree s >>= function - | None -> f t >|= fun x -> Ok x (* no transaction is needed *) + | None -> + f t >|= fun x -> Ok x (* no transaction is needed *) | Some (origin, old_tree) -> let batch = {repo; tree= old_tree; origin} in let b = Batch batch in @@ -151,8 +155,10 @@ let _ = foo >>= function[@warning "-4"] A -> false | B -> true let _ = foo >>= function[@warning "-4"] - | Afoooooooooooooooooo fooooooooo -> false - | Bfoooooooooooooooooooooo fooooooooo -> true + | Afoooooooooooooooooo fooooooooo -> + false + | Bfoooooooooooooooooooooo fooooooooo -> + true let _ = foo >>= fun [@warning "-4"] x -> fooooooooooooooooooooooo @@ -163,8 +169,10 @@ let _ = let _ = foo >>= function(* foo before *) [@warning "-4"] (* foo after *) - | Afoooooooooooooooooo fooooooooo -> false - | Bfoooooooooooooooooooooo fooooooooo -> true + | Afoooooooooooooooooo fooooooooo -> + false + | Bfoooooooooooooooooooooo fooooooooo -> + true let _ = foo >>= fun (* foo before *) [@warning "-4"] (* foo after *) x -> @@ -182,7 +190,8 @@ let f = Ok () >>= (* *) function Foo -> Ok () let f = (* fooooooooooooooo foooooooooooooooo *) Ok () >>= (* *) function - | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + | Foo -> + Ok foooooooooooooooooooooooooooooooooooooooooooooooooo let f = Ok () @@ -196,7 +205,8 @@ let f = >>= (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) function - | Foo -> Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + | Foo -> + Ok foooooooooooooooooooooooooooooooooooooooooooooooooo (** The tests below are testing a dropped comment with `--no-break-infix-before-func` *) diff --git a/test/passing/refs.ocamlformat/infix_bind.ml.ref b/test/passing/refs.ocamlformat/infix_bind.ml.ref new file mode 100644 index 0000000000..4340beb875 --- /dev/null +++ b/test/passing/refs.ocamlformat/infix_bind.ml.ref @@ -0,0 +1,246 @@ +f x >>= fun y -> +g y >>= fun () -> +f x >>= fun y -> +g y >>= fun () -> +f x >>= fun y -> +g y >>= fun () -> y () +;; + +f x >>= function +| A -> ( + g y >>= fun () -> + f x >>= fun y -> + g y >>= function + | x -> ( + f x >>= fun y -> + g y >>= function _ -> y () ) ) +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x ;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> fun x -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> fun x -> x ;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee +|> fun xxxxxx xxxxxxxxxx xxxxxxxx xxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> fun xxxxxxxxx xxxxxxxxxxxxx -> x ;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee +|> fun xxxxxxxx xxxxxxxxx xxxxxxxxxxxxx -> x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> fun xxxxxxxxxxxxx -> +xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee +|> fun xxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxxxxxxx xxxxxxxxx -> +xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function x -> x ;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function +| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> + x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> function +| x -> + x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeeee + eeeeeeeeeeee eeeeeeeeee +|> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx +;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function x -> x ;; + +eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee |> function +| xxxxxx, xxxxxxxxxx, xxxxxxxx, xxxxxxxx -> + x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function xxxxxxxxx, xxxxxxxxxxxxx -> x ;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee eeeeeeeeeeeeeeeeeee |> function +| xxxxxxxx, xxxxxxxxx, xxxxxxxxxxxxx -> + x +;; + +eeeeeeeeeeeee eeeeeeeeeeeeeeeeee |> function +| xxxxxxxxxxxxx -> + xxxxxxxx xxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx +;; + +eeeeeeeeeeeee eeeeeeeeee |> function +| xxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxxxxxxx, xxxxxxxxx -> + xxxxxxxxxxx xxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxx xxxxxxxxxxx + +let parens = + match body with + | {pexp_desc= Pexp_function cs; pexp_attributes; pexp_loc} -> + update_config_maybe_disabled c pexp_loc pexp_attributes @@ fun c -> + fmt "@ " + $ Cmts.fmt c.cmts pexp_loc + (wrap_if parens "(" ")" + ( fmt "function" $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box $ fmt "@ " $ fmt_cases c ctx cs ) ) + | _ -> + close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody + +let parens = + match body with + | {pexp_desc= Pexp_function cs; pexp_attributes; pexp_loc} -> ( + update_config_maybe_disabled c pexp_loc pexp_attributes @@ function + | _ -> + fmt "@ " + $ Cmts.fmt c.cmts pexp_loc + (wrap_if parens "(" ")" + ( fmt "function" $ fmt_extension_suffix c ext + $ fmt_attributes c ~key:"@" pexp_attributes + $ close_box $ fmt "@ " $ fmt_cases c ctx cs ) ) + | _ -> + close_box $ fmt "@ " $ fmt_expression c ~eol:(fmt "@;<1000 0>") xbody + ) + +let end_gen_implementation ?toplevel ~ppf_dump (clambda : clambda_and_constants) + = + Emit.begin_assembly () ; + ( clambda + ++ Profile.record "cmm" (Cmmgen.compunit ~ppf_dump) + ++ Profile.record "compile_phrases" (List.iter (compile_phrase ~ppf_dump)) + ++ fun () -> () ) ; + fooooooooooooooo + +let foo = + (* get the tree origin *) + get_store_tree s >>= function + | None -> + f t >|= fun x -> Ok x (* no transaction is needed *) + | Some (origin, old_tree) -> + let batch = {repo; tree= old_tree; origin} in + let b = Batch batch in + foo + +let _ = foo >>= function[@warning "-4"] A -> false | B -> true + +let _ = + foo >>= function[@warning "-4"] + | Afoooooooooooooooooo fooooooooo -> + false + | Bfoooooooooooooooooooooo fooooooooo -> + true + +let _ = foo >>= fun [@warning "-4"] x -> fooooooooooooooooooooooo + +let _ = + foo >>= fun [@warning "-4"] x y -> + fooooooooooooooooooooooo fooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooooooo + +let _ = + foo >>= function(* foo before *) [@warning "-4"] (* foo after *) + | Afoooooooooooooooooo fooooooooo -> + false + | Bfoooooooooooooooooooooo fooooooooo -> + true + +let _ = + foo >>= fun (* foo before *) [@warning "-4"] (* foo after *) x -> + fooooooooooooooooooooooo + +let f = Ok () >>= (* *) fun _ -> Ok () + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () >>= (* *) fun _ -> + Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +let f = Ok () >>= (* *) function Foo -> Ok () + +let f = + (* fooooooooooooooo foooooooooooooooo *) + Ok () >>= (* *) function + | Foo -> + Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + fun foooooo fooooo foooo foooooo -> + Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +let f = + Ok () + >>= + (* fooooooooooooooo fooooooooooooooo fooooooooooooooo foooooooooooooooo *) + function + | Foo -> + Ok foooooooooooooooooooooooooooooooooooooooooooooooooo + +(** The tests below are testing a dropped comment with + `--no-break-infix-before-func` *) + +let _ = x |> fun y -> y (* *) + +let _ = x |> function y -> y (* *) + +let _ = match () with A -> ( x |> function y -> y (* *) ) | B -> () + +let _ = x |> function y -> ( function _ -> y (* A *) ) (* B *) + +let _ = () (* This is needed here to avoid the comment above from moving *) + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k + +let encoder f = + let field_encode = unstage (t f.ftype) in + stagged @@ fun x k : t -> field_encode (f.fget x) k + +let default = + command##hasPermission #= (fun ctx -> foooooooooooooooooo fooooooooooo) ; + command##hasPermission #= (fun ctx -> + foooooooooooooooooo fooooooooooo foooooo fooooooooo foooooooooo ) ; + foo + +let _ = ( let* ) x (fun y -> z) + +let _ = ( let* ) x (function y -> z) + +let _ = f (( let* ) x (fun y -> z)) + +let _ = f (( let* ) x (function y -> z)) + +let _ = (x >>= fun () -> ()) [@a] + +let _ = ( >>= ) [@attr] + +let _ = f (( >>= ) [@attr]) ;; + +( >>= ) [@attr] diff --git a/test/passing/refs.ocamlformat/infix_precedence.ml.ref b/test/passing/refs.ocamlformat/infix_precedence.ml.ref new file mode 100644 index 0000000000..da6ffe43c0 --- /dev/null +++ b/test/passing/refs.ocamlformat/infix_precedence.ml.ref @@ -0,0 +1,13 @@ +let dolore_tempor_in_duis duis_esse esse = + let duis_nisi = Occaecat.sed_duis_nisi duis_esse in + do_dolore_quis_dolore duis_nisi esse + || ( (not + ( match duis_nisi with + | Qui.Occaecat.Enim esse_magna -> + Qui.Occaecat.Enim.do_commodo_dolore esse_magna + | _ -> + false ) ) + && Occaecat.sed_aliqua duis_esse <> PariAtur.Aliquip + && not + (Adipisicing.magna_tempor_ipsum_elit_nisi duis_esse + Adipisicing.loremipSumDolorsi ) ) diff --git a/test/passing/refs.ocamlformat/injectivity.ml.ref b/test/passing/refs.ocamlformat/injectivity.ml.ref new file mode 100644 index 0000000000..ea909bba79 --- /dev/null +++ b/test/passing/refs.ocamlformat/injectivity.ml.ref @@ -0,0 +1,90 @@ +type !'a t = private 'a ref + +type +!'a t = private 'a + +type -!'a t = private 'a -> unit + +type +!'a t = private 'a + +type -!'a t = private 'a -> unit + +type +!'a t = private 'a + +type -!'a t = private 'a -> unit + +type +!'a t = private 'a + +type -!'a t = private 'a -> unit + +module M : sig + type +!'a t +end = struct + type 'a t = 'a list +end + +module N : sig + type +'a t +end = struct + type 'a t = 'a list +end + +type !'a t = 'a list + +type !'a u = int + +module M : sig + type !'a t = private < m: int ; .. > +end = struct + type 'a t = < m: int > +end + +type 'a t = 'b constraint 'a = < b: 'b > + +type !'b u = < b: 'b > t + +type !_ t = X + +type (_, _) eq = Refl : ('a, 'a) eq + +type !'a t = private 'b constraint 'a = < b: 'b > + +type !'a t = private 'b constraint 'a = < b: 'b ; c: 'c > + +module M : sig + type !'a t constraint 'a = < b: 'b ; c: 'c > +end = struct + type nonrec 'a t = 'a t +end + +type !'a u = int constraint 'a = 'b t + +module F (X : sig + type 'a t +end) = +struct + type !'a u = 'b constraint 'a = < b: 'b > constraint 'b = _ X.t +end + +module F (X : sig + type 'a t +end) = +struct + type !'a u = 'b X.t constraint 'a = < b: 'b X.t > +end + +module F (X : sig + type 'a t +end) = +struct + type !'a u = 'b constraint 'a = < b: (_ X.t as 'b) > +end + +module rec R : sig + type !'a t = [`A of 'a S.t] +end = + R + +and S : sig + type !'a t = 'a R.t +end = + S diff --git a/test/passing/refs.ocamlformat/into_infix.ml.ref b/test/passing/refs.ocamlformat/into_infix.ml.ref new file mode 100644 index 0000000000..f55d9f49d1 --- /dev/null +++ b/test/passing/refs.ocamlformat/into_infix.ml.ref @@ -0,0 +1 @@ +let a = 1 < 3 diff --git a/test/passing/refs.ocamlformat/invalid.ml.ref b/test/passing/refs.ocamlformat/invalid.ml.ref new file mode 100644 index 0000000000..d2c547c553 --- /dev/null +++ b/test/passing/refs.ocamlformat/invalid.ml.ref @@ -0,0 +1,13 @@ +let f = function "as" .. 3 | 3. .. 'q' | 3 .. -3. | -3. .. 3 -> () + +let f = function (lazy (exception A)) -> () | exception (lazy A) -> () + +let f = (A) a b + +let f = (A x) a b + +let f = (`A) a b + +let f = (`A x) a b + +let f = (( :: )) a b c diff --git a/test/passing/refs.ocamlformat/invalid_docstring.ml.ref b/test/passing/refs.ocamlformat/invalid_docstring.ml.ref new file mode 100644 index 0000000000..3c220e968d --- /dev/null +++ b/test/passing/refs.ocamlformat/invalid_docstring.ml.ref @@ -0,0 +1 @@ +(**{v*) diff --git a/test/passing/refs.ocamlformat/invalid_docstrings.mli.ref b/test/passing/refs.ocamlformat/invalid_docstrings.mli.ref new file mode 100644 index 0000000000..b563eee459 --- /dev/null +++ b/test/passing/refs.ocamlformat/invalid_docstrings.mli.ref @@ -0,0 +1,8 @@ +val x : y +(** Blablabla. Otherwise, the given protocol can not be: + {ul + {- registered into {!resolvers}} + {- used as a service with {!serve_with_handler]/{!serve}}} + [protocol] can be hidden - but must be registered with + {!register_protocol}. However, blablabla. +*) diff --git a/test/passing/refs.ocamlformat/issue114.ml.ref b/test/passing/refs.ocamlformat/issue114.ml.ref new file mode 100644 index 0000000000..dbbb06ff33 --- /dev/null +++ b/test/passing/refs.ocamlformat/issue114.ml.ref @@ -0,0 +1 @@ +let () = (f ()).(2) <- e diff --git a/test/passing/refs.ocamlformat/issue1750.ml.err b/test/passing/refs.ocamlformat/issue1750.ml.err new file mode 100644 index 0000000000..f355dc6524 --- /dev/null +++ b/test/passing/refs.ocamlformat/issue1750.ml.err @@ -0,0 +1 @@ +Warning: issue1750.ml:20 exceeds the margin diff --git a/test/passing/refs.ocamlformat/issue1750.ml.ref b/test/passing/refs.ocamlformat/issue1750.ml.ref new file mode 100644 index 0000000000..63712093c4 --- /dev/null +++ b/test/passing/refs.ocamlformat/issue1750.ml.ref @@ -0,0 +1,79 @@ +let _ = + all + [ all + [ all + [ all + [ f + (all + [ all + [ all + [ all + [ all + [ all + [ all + [ all + [ all + [ all + [ all + [ all + [ all + [ all + [ identify + ] ] + ] ] ] ] ] ] + ] ] ] ] ] ] ) ] ] ] ] + +let _ = function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | [%p + function + | _ -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + ()] -> + () diff --git a/test/passing/refs.ocamlformat/issue289.ml.ref b/test/passing/refs.ocamlformat/issue289.ml.ref new file mode 100644 index 0000000000..6bd6ceb508 --- /dev/null +++ b/test/passing/refs.ocamlformat/issue289.ml.ref @@ -0,0 +1,94 @@ +[@@@ocamlformat "wrap-fun-args=false"] + +let foo = + let open Gql in + [ field "id" ~doc:"Toy ID." ~args:[] ~typ:(non_null guid) ~resolve:(function + | _ctx -> x.id ) + ; field "id" ~doc:"Toy ID." ~args:[] ~typppp ~resolve:(function _ctx -> x.id) + ; field "id" ~doc:"Toy ID." ~args:[] ~typ:(non_null guid) ~resolve:(function + | A -> + x.id + | B -> + c ) + ; field "id" ~doc:"Toy ID." ~args:[] ~resolve:(function A -> x.id | B -> c) + ; field + "id" + ~doc:"Toy ID." + ~args:[] + ~typppppppppppppppppppp + ~resolve:(function + | AAAAAAAAAAAAAAAAAAAa -> + x.idddddddddddddddddddddddddd + | BBBBBBBBBBBBBBBB -> + ccccccccccccccccccccccc ) + ; field "id" ~doc:"Toy ID." ~args:[] ~resolve:(function + | AAAAAAAAAAAAAAAAAAAa -> + x.idddddddddddddddddddddddddd + | BBBBBBBBBBBBBBBB -> + ccccccccccccccccccccccc ) + ; field + "id" + ~doc:"Toy ID." + ~args:[] + ~typ:(non_null guid) + ~resolve:(fun _ctx x -> x.id ) + ; field + "name" + ~doc:"Toy name." + ~args:[] + ~typ:(non_null string) + ~resolve:(fun _ctx x -> x.name ) + ; field + "description" + ~doc:"Toy description." + ~args:[] + ~typ:string + ~resolve:(fun _ctx x -> x.description |> Util.option_of_string ) + ; field + "type" + ~doc:"Toy type. Possible values are: car, animal, train." + ~args:[] + ~typ:(non_null toy_type_enum) + ~resolve:(fun _ctx x -> x.toy_type ) + ; field + "createdAt" + ~doc:"Date created." + ~args:[] + ~typ:(non_null Scalar.date_time) + ~resolve:(fun _ctx x -> x.created_at ) ] + +[@@@ocamlformat "wrap-fun-args=true"] + +let foo = + let open Gql in + [ field "id" ~doc:"Toy ID." ~args:[] ~typ:(non_null guid) ~resolve:(function + | _ctx -> x.id ) + ; field "id" ~doc:"Toy ID." ~args:[] ~typppp ~resolve:(function _ctx -> x.id) + ; field "id" ~doc:"Toy ID." ~args:[] ~typ:(non_null guid) ~resolve:(function + | A -> + x.id + | B -> + c ) + ; field "id" ~doc:"Toy ID." ~args:[] ~resolve:(function A -> x.id | B -> c) + ; field "id" ~doc:"Toy ID." ~args:[] ~typppppppppppppppppppp + ~resolve:(function + | AAAAAAAAAAAAAAAAAAAa -> + x.idddddddddddddddddddddddddd + | BBBBBBBBBBBBBBBB -> + ccccccccccccccccccccccc ) + ; field "id" ~doc:"Toy ID." ~args:[] ~resolve:(function + | AAAAAAAAAAAAAAAAAAAa -> + x.idddddddddddddddddddddddddd + | BBBBBBBBBBBBBBBB -> + ccccccccccccccccccccccc ) + ; field "id" ~doc:"Toy ID." ~args:[] ~typ:(non_null guid) + ~resolve:(fun _ctx x -> x.id ) + ; field "name" ~doc:"Toy name." ~args:[] ~typ:(non_null string) + ~resolve:(fun _ctx x -> x.name ) + ; field "description" ~doc:"Toy description." ~args:[] ~typ:string + ~resolve:(fun _ctx x -> x.description |> Util.option_of_string ) + ; field "type" ~doc:"Toy type. Possible values are: car, animal, train." + ~args:[] ~typ:(non_null toy_type_enum) ~resolve:(fun _ctx x -> + x.toy_type ) + ; field "createdAt" ~doc:"Date created." ~args:[] + ~typ:(non_null Scalar.date_time) ~resolve:(fun _ctx x -> x.created_at ) ] diff --git a/test/passing/refs.ocamlformat/issue48.ml.ref b/test/passing/refs.ocamlformat/issue48.ml.ref new file mode 100644 index 0000000000..6e59f8718d --- /dev/null +++ b/test/passing/refs.ocamlformat/issue48.ml.ref @@ -0,0 +1,3 @@ +module X (* : sig val x : unit -> unit end *) = struct + let x () = print_endline "coucou" +end diff --git a/test/passing/refs.ocamlformat/issue51.ml.ref b/test/passing/refs.ocamlformat/issue51.ml.ref new file mode 100644 index 0000000000..df38e0bd06 --- /dev/null +++ b/test/passing/refs.ocamlformat/issue51.ml.ref @@ -0,0 +1,2 @@ +val run : + unit -> (unit -> ('a, ([> `Msg of string] as 'b)) result) -> ('a, 'b) result diff --git a/test/passing/refs.ocamlformat/issue57.ml.ref b/test/passing/refs.ocamlformat/issue57.ml.ref new file mode 100644 index 0000000000..b4eab1d0cc --- /dev/null +++ b/test/passing/refs.ocamlformat/issue57.ml.ref @@ -0,0 +1,5 @@ +let f (`A x) = x + +let f x = + let (`A y) = x in + y diff --git a/test/passing/refs.ocamlformat/issue60.ml.ref b/test/passing/refs.ocamlformat/issue60.ml.ref new file mode 100644 index 0000000000..07a9b8e409 --- /dev/null +++ b/test/passing/refs.ocamlformat/issue60.ml.ref @@ -0,0 +1 @@ +let x : unit = () diff --git a/test/passing/refs.ocamlformat/issue77.ml.ref b/test/passing/refs.ocamlformat/issue77.ml.ref new file mode 100644 index 0000000000..33348811c5 --- /dev/null +++ b/test/passing/refs.ocamlformat/issue77.ml.ref @@ -0,0 +1,8 @@ +let div = + [ div + ~a: + [ Reactive.a_style + (React.S.map (sprintf "height: %dpx") + (State.player_height_signal app_state) ) + (* ksprintf a_style "%s" (if_smth "min-height: 300px;" ""); *) ] + content ] diff --git a/test/passing/refs.ocamlformat/issue85.ml.ref b/test/passing/refs.ocamlformat/issue85.ml.ref new file mode 100644 index 0000000000..e91d73ce0c --- /dev/null +++ b/test/passing/refs.ocamlformat/issue85.ml.ref @@ -0,0 +1,5 @@ +let f (module X) = X.x + +let f = function `A {x: int = _} -> () + +let f (`A | `B) = () diff --git a/test/passing/refs.ocamlformat/issue89.ml.ref b/test/passing/refs.ocamlformat/issue89.ml.ref new file mode 100644 index 0000000000..6a9b7db0c4 --- /dev/null +++ b/test/passing/refs.ocamlformat/issue89.ml.ref @@ -0,0 +1 @@ +let f x = !(x.(0)) diff --git a/test/passing/tests/ite-compact.ml.ref b/test/passing/refs.ocamlformat/ite-compact.ml.ref similarity index 96% rename from test/passing/tests/ite-compact.ml.ref rename to test/passing/refs.ocamlformat/ite-compact.ml.ref index efaae2aed9..2cac95f1f4 100644 --- a/test/passing/tests/ite-compact.ml.ref +++ b/test/passing/refs.ocamlformat/ite-compact.ml.ref @@ -33,15 +33,13 @@ f ;; f - ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger - then () + ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () else () ) ;; f - ( if - and_ even - loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else () ) @@ -49,8 +47,7 @@ let () = f ( if a___________________________________________________________________ then b_________________________________________________________________ - else c_________________________________________________________________ - ) + else c_________________________________________________________________ ) let () = if [@test] true then () else if [@other] true then () @@ -129,8 +126,8 @@ let foo = false else if cmp > 0 then (* context higher prec than ast: add parens *) true - else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) - then foo + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo let _ = if fooo then ( + ) diff --git a/test/passing/tests/ite-compact_closing.ml.ref b/test/passing/refs.ocamlformat/ite-compact_closing.ml.ref similarity index 94% rename from test/passing/tests/ite-compact_closing.ml.ref rename to test/passing/refs.ocamlformat/ite-compact_closing.ml.ref index 026ae8d81a..bf6bc52e70 100644 --- a/test/passing/tests/ite-compact_closing.ml.ref +++ b/test/passing/refs.ocamlformat/ite-compact_closing.ml.ref @@ -39,16 +39,14 @@ f ;; f - ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger - then () + ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () else () ) ;; f - ( if - and_ even - loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else () ) @@ -98,25 +96,19 @@ let foo = arm1 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo - ) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) ) else if cond2 then ( arm2 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo - ) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) ) else ( arm3 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo - ) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) ) let foo = @@ -144,8 +136,8 @@ let foo = false else if cmp > 0 then (* context higher prec than ast: add parens *) true - else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) - then foo + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo let _ = if fooo then ( + ) diff --git a/test/passing/tests/ite-fit_or_vertical.ml.ref b/test/passing/refs.ocamlformat/ite-fit_or_vertical.ml.ref similarity index 96% rename from test/passing/tests/ite-fit_or_vertical.ml.ref rename to test/passing/refs.ocamlformat/ite-fit_or_vertical.ml.ref index 00da114648..90047ff79b 100644 --- a/test/passing/tests/ite-fit_or_vertical.ml.ref +++ b/test/passing/refs.ocamlformat/ite-fit_or_vertical.ml.ref @@ -40,17 +40,14 @@ f ;; f - ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger - then + ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else () ) ;; f - ( if - and_ even - loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else @@ -153,8 +150,7 @@ let foo = false else if cmp > 0 then (* context higher prec than ast: add parens *) true - else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) - then + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then foo let _ = diff --git a/test/passing/tests/ite-fit_or_vertical_closing.ml.ref b/test/passing/refs.ocamlformat/ite-fit_or_vertical_closing.ml.ref similarity index 95% rename from test/passing/tests/ite-fit_or_vertical_closing.ml.ref rename to test/passing/refs.ocamlformat/ite-fit_or_vertical_closing.ml.ref index 6e19cc2bf3..dfe0e6b7ea 100644 --- a/test/passing/tests/ite-fit_or_vertical_closing.ml.ref +++ b/test/passing/refs.ocamlformat/ite-fit_or_vertical_closing.ml.ref @@ -44,8 +44,7 @@ f ;; f - ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger - then + ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else () @@ -53,9 +52,7 @@ f ;; f - ( if - and_ even - loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else @@ -118,23 +115,17 @@ let foo = arm1 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo - ) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) ) else if cond2 then ( arm2 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo - ) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) ) else ( arm3 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo - ) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) ) let foo = @@ -165,8 +156,7 @@ let foo = false else if cmp > 0 then (* context higher prec than ast: add parens *) true - else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) - then + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then foo let _ = diff --git a/test/passing/refs.ocamlformat/ite-fit_or_vertical_no_indicate.ml.err b/test/passing/refs.ocamlformat/ite-fit_or_vertical_no_indicate.ml.err new file mode 100644 index 0000000000..560b57ab97 --- /dev/null +++ b/test/passing/refs.ocamlformat/ite-fit_or_vertical_no_indicate.ml.err @@ -0,0 +1,3 @@ +Warning: ite-fit_or_vertical_no_indicate.ml:109 exceeds the margin +Warning: ite-fit_or_vertical_no_indicate.ml:114 exceeds the margin +Warning: ite-fit_or_vertical_no_indicate.ml:119 exceeds the margin diff --git a/test/passing/tests/ite-fit_or_vertical_no_indicate.ml.ref b/test/passing/refs.ocamlformat/ite-fit_or_vertical_no_indicate.ml.ref similarity index 95% rename from test/passing/tests/ite-fit_or_vertical_no_indicate.ml.ref rename to test/passing/refs.ocamlformat/ite-fit_or_vertical_no_indicate.ml.ref index f54b1c89ce..14952ce467 100644 --- a/test/passing/tests/ite-fit_or_vertical_no_indicate.ml.ref +++ b/test/passing/refs.ocamlformat/ite-fit_or_vertical_no_indicate.ml.ref @@ -40,17 +40,14 @@ f ;; f - (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger - then + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ()) ;; f - (if - and_ even - loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else @@ -110,20 +107,17 @@ let foo = arm1 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo)) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) else if cond2 then ( arm2 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo)) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) else ( arm3 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo)) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) let foo = if some condition then @@ -153,8 +147,7 @@ let foo = false else if cmp > 0 then (* context higher prec than ast: add parens *) true - else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) - then + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then foo let _ = diff --git a/test/passing/tests/ite-kr.ml.ref b/test/passing/refs.ocamlformat/ite-kr.ml.ref similarity index 97% rename from test/passing/tests/ite-kr.ml.ref rename to test/passing/refs.ocamlformat/ite-kr.ml.ref index ff2da5ed85..e29008b85b 100644 --- a/test/passing/tests/ite-kr.ml.ref +++ b/test/passing/refs.ocamlformat/ite-kr.ml.ref @@ -47,17 +47,14 @@ f ;; f - ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger - then + ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else () ) ;; f - ( if - and_ even - loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else @@ -183,8 +180,7 @@ let foo = false else if cmp > 0 then (* context higher prec than ast: add parens *) true - else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) - then + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then foo let _ = diff --git a/test/passing/tests/ite-kr_closing.ml.ref b/test/passing/refs.ocamlformat/ite-kr_closing.ml.ref similarity index 95% rename from test/passing/tests/ite-kr_closing.ml.ref rename to test/passing/refs.ocamlformat/ite-kr_closing.ml.ref index 0145fe1143..e2cf5c38d5 100644 --- a/test/passing/tests/ite-kr_closing.ml.ref +++ b/test/passing/refs.ocamlformat/ite-kr_closing.ml.ref @@ -49,8 +49,7 @@ f ;; f - ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger - then + ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else () @@ -58,9 +57,7 @@ f ;; f - ( if - and_ even - loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else @@ -139,23 +136,17 @@ let foo = arm1 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo - ) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) ) else if cond2 then ( arm2 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo - ) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) ) else ( arm3 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo - ) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) ) let foo = @@ -193,8 +184,7 @@ let foo = false else if cmp > 0 then (* context higher prec than ast: add parens *) true - else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) - then + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then foo let _ = diff --git a/test/passing/tests/ite-kw_first.ml.ref b/test/passing/refs.ocamlformat/ite-kw_first.ml.ref similarity index 97% rename from test/passing/tests/ite-kw_first.ml.ref rename to test/passing/refs.ocamlformat/ite-kw_first.ml.ref index 7b4877f43a..504bda1598 100644 --- a/test/passing/tests/ite-kw_first.ml.ref +++ b/test/passing/refs.ocamlformat/ite-kw_first.ml.ref @@ -45,9 +45,7 @@ f ;; f - ( if - and_ even - loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else () ) @@ -55,8 +53,7 @@ let () = f ( if a___________________________________________________________________ then b_________________________________________________________________ - else c_________________________________________________________________ - ) + else c_________________________________________________________________ ) let () = if [@test] true then () else if [@other] true then () diff --git a/test/passing/tests/ite-kw_first_closing.ml.ref b/test/passing/refs.ocamlformat/ite-kw_first_closing.ml.ref similarity index 95% rename from test/passing/tests/ite-kw_first_closing.ml.ref rename to test/passing/refs.ocamlformat/ite-kw_first_closing.ml.ref index 9f9671be8a..131b695c72 100644 --- a/test/passing/tests/ite-kw_first_closing.ml.ref +++ b/test/passing/refs.ocamlformat/ite-kw_first_closing.ml.ref @@ -52,9 +52,7 @@ f ;; f - ( if - and_ even - loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else () ) @@ -112,26 +110,20 @@ let foo = arm1 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo - ) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) ) else if cond2 then ( arm2 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo - ) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) ) else ( arm3 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo - ) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo) ) let foo = diff --git a/test/passing/refs.ocamlformat/ite-kw_first_no_indicate.ml.err b/test/passing/refs.ocamlformat/ite-kw_first_no_indicate.ml.err new file mode 100644 index 0000000000..f87d9d5073 --- /dev/null +++ b/test/passing/refs.ocamlformat/ite-kw_first_no_indicate.ml.err @@ -0,0 +1,3 @@ +Warning: ite-kw_first_no_indicate.ml:102 exceeds the margin +Warning: ite-kw_first_no_indicate.ml:108 exceeds the margin +Warning: ite-kw_first_no_indicate.ml:113 exceeds the margin diff --git a/test/passing/tests/ite-kw_first_no_indicate.ml.ref b/test/passing/refs.ocamlformat/ite-kw_first_no_indicate.ml.ref similarity index 96% rename from test/passing/tests/ite-kw_first_no_indicate.ml.ref rename to test/passing/refs.ocamlformat/ite-kw_first_no_indicate.ml.ref index 44d47dee62..e42dc20a6d 100644 --- a/test/passing/tests/ite-kw_first_no_indicate.ml.ref +++ b/test/passing/refs.ocamlformat/ite-kw_first_no_indicate.ml.ref @@ -45,9 +45,7 @@ f ;; f - (if - and_ even - loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ()) @@ -102,21 +100,18 @@ let foo = arm1 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo)) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) else if cond2 then ( arm2 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo)) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) else ( arm3 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo)) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) let foo = if some condition diff --git a/test/passing/refs.ocamlformat/ite-no_indicate.ml.err b/test/passing/refs.ocamlformat/ite-no_indicate.ml.err new file mode 100644 index 0000000000..9ed8e5c1e6 --- /dev/null +++ b/test/passing/refs.ocamlformat/ite-no_indicate.ml.err @@ -0,0 +1,3 @@ +Warning: ite-no_indicate.ml:88 exceeds the margin +Warning: ite-no_indicate.ml:93 exceeds the margin +Warning: ite-no_indicate.ml:98 exceeds the margin diff --git a/test/passing/tests/ite-no_indicate.ml.ref b/test/passing/refs.ocamlformat/ite-no_indicate.ml.ref similarity index 94% rename from test/passing/tests/ite-no_indicate.ml.ref rename to test/passing/refs.ocamlformat/ite-no_indicate.ml.ref index 112af2028e..2b7badbe5c 100644 --- a/test/passing/tests/ite-no_indicate.ml.ref +++ b/test/passing/refs.ocamlformat/ite-no_indicate.ml.ref @@ -33,15 +33,13 @@ f ;; f - (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger - then () + (if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () else ()) ;; f - (if - and_ even - loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + (if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else ()) @@ -88,20 +86,17 @@ let foo = arm1 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo)) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) else if cond2 then ( arm2 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo)) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) else ( arm3 ; foooooooooooooo ; fooooooooooooooooooo fooooooooooooooo foooooooooooo ; - List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> - fooooooooooooo)) + List.foo ~fooooooo:foooooooooooooooo ~foo:(fun fooooooooo -> fooooooooooooo)) let foo = if some condition then @@ -128,8 +123,8 @@ let foo = false else if cmp > 0 then (* context higher prec than ast: add parens *) true - else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) - then foo + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo let _ = if fooo then ( + ) diff --git a/test/passing/tests/ite-vertical.ml.ref b/test/passing/refs.ocamlformat/ite-vertical.ml.ref similarity index 97% rename from test/passing/tests/ite-vertical.ml.ref rename to test/passing/refs.ocamlformat/ite-vertical.ml.ref index 6960bb2b6e..bf4a3fcd00 100644 --- a/test/passing/tests/ite-vertical.ml.ref +++ b/test/passing/refs.ocamlformat/ite-vertical.ml.ref @@ -44,17 +44,14 @@ f ;; f - ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger - then + ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else () ) ;; f - ( if - and_ even - loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else @@ -181,8 +178,7 @@ let foo = false else if cmp > 0 then (* context higher prec than ast: add parens *) true - else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) - then + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then foo let _ = diff --git a/test/passing/tests/ite.ml.ref b/test/passing/refs.ocamlformat/ite.ml.ref similarity index 96% rename from test/passing/tests/ite.ml.ref rename to test/passing/refs.ocamlformat/ite.ml.ref index efaae2aed9..2cac95f1f4 100644 --- a/test/passing/tests/ite.ml.ref +++ b/test/passing/refs.ocamlformat/ite.ml.ref @@ -33,15 +33,13 @@ f ;; f - ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger - then () + ( if even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then + () else () ) ;; f - ( if - and_ even - loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger + ( if and_ even loooooooooooooooooooooooooooooooooooooooooooooooooooooooooonger then () else () ) @@ -49,8 +47,7 @@ let () = f ( if a___________________________________________________________________ then b_________________________________________________________________ - else c_________________________________________________________________ - ) + else c_________________________________________________________________ ) let () = if [@test] true then () else if [@other] true then () @@ -129,8 +126,8 @@ let foo = false else if cmp > 0 then (* context higher prec than ast: add parens *) true - else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) - then foo + else if Poly.(assoc_of_prec prec_ast = which_child && which_child <> Non) then + foo let _ = if fooo then ( + ) diff --git a/test/passing/tests/js_args.ml.ref b/test/passing/refs.ocamlformat/js_args.ml.ref similarity index 86% rename from test/passing/tests/js_args.ml.ref rename to test/passing/refs.ocamlformat/js_args.ml.ref index 5d3c7bf356..b989af2a99 100644 --- a/test/passing/tests/js_args.ml.ref +++ b/test/passing/refs.ocamlformat/js_args.ml.ref @@ -4,7 +4,7 @@ let should_check_can_sell_and_marking regulatory_regime = match z with `foo -> some_function argument (* The above typically occurs in a multi-pattern match clause, so the clause - expression is on a line by itself. This is the more typical way a long + expression is on a line by itself. This is the more typical way a long single-pattern match clause would be written: *) let should_check_can_sell_and_marking regulatory_regime = match z with `foo -> some_function argument @@ -40,24 +40,23 @@ let () = raise (Bug ( "foo" - (* In this and similar cases, we want the subsequent lines to align - with the first expression. *) + (* In this and similar cases, we want the subsequent lines to + align with the first expression. *) ^ "bar" ) ) ; raise (Bug ("foo" ^ "quux" ^ "bar")) ; raise (Bug ((foo + quux) ^ "bar")) ; raise (Bug ((foo + quux) ^ "bar")) (* Except in specific cases, we want the argument indented relative to the - function being called. (Exceptions include "fun" arguments where the line - ends with "->" and subsequent lines beginning with operators, like - above.) *) + function being called. (Exceptions include "fun" arguments where the line + ends with "->" and subsequent lines beginning with operators, like above.) *) let () = Some (Message_store.create s "herd-retransmitter" ~unlink:true Message_store.Message_size.Byte ) -(* We like the indentation of most arguments, but want to get back towards - the left margin in a few special cases: *) +(* We like the indentation of most arguments, but want to get back towards the + left margin in a few special cases: *) let _ = foo (bar (fun x -> @@ -78,9 +77,10 @@ let _ = baz ) ) ) ) (* We also wanted to tweak the operator indentation, making operators like <= - not special cases in contexts like this: *) + not special cases in contexts like this: *) let _ = assert (foo (bar + baz <= quux)) -(* lined up under left argument to op, sim. to ^ above *) +(* lined up under left argument to op, + sim. to ^ above *) (* Sim. indentation of if conditions: *) let _ = if a <= b then () @@ -92,7 +92,7 @@ let _ = let _ = (* We regard the outermost condition terms as conceptually part of the [if] - expression and indent accordingly. Whether [&&] or [||], conditionals + expression and indent accordingly. Whether [&&] or [||], conditionals effectively state lists of conditions for [then]. *) if Edge_adjustment.is_zero arb.cfg.extra_edge diff --git a/test/passing/tests/js_begin.ml.ref b/test/passing/refs.ocamlformat/js_begin.ml.ref similarity index 100% rename from test/passing/tests/js_begin.ml.ref rename to test/passing/refs.ocamlformat/js_begin.ml.ref diff --git a/test/passing/refs.ocamlformat/js_bind.ml.err b/test/passing/refs.ocamlformat/js_bind.ml.err new file mode 100644 index 0000000000..c28a2cabe3 --- /dev/null +++ b/test/passing/refs.ocamlformat/js_bind.ml.err @@ -0,0 +1 @@ +Warning: js_bind.ml:16 exceeds the margin diff --git a/test/passing/tests/js_bind.ml.ref b/test/passing/refs.ocamlformat/js_bind.ml.ref similarity index 57% rename from test/passing/tests/js_bind.ml.ref rename to test/passing/refs.ocamlformat/js_bind.ml.ref index 4cdbd05986..c7f62686c7 100644 --- a/test/passing/tests/js_bind.ml.ref +++ b/test/passing/refs.ocamlformat/js_bind.ml.ref @@ -5,16 +5,13 @@ let assigned_to u = status_request ~request () ~msg_client:no_msg >>= fun status -> not (up_to_date_user status u) ) -let old_good = - foo bar qaz *>>= fun x -> hey ho lala *>>= fun y -> return (x, y) +let old_good = foo bar qaz *>>= fun x -> hey ho lala *>>= fun y -> return (x, y) -let old_good = - foo bar qaz +>>= fun x -> hey ho lala +>>= fun y -> return (x, y) +let old_good = foo bar qaz +>>= fun x -> hey ho lala +>>= fun y -> return (x, y) (* generalizations based on Tuareg code *) let old_good = foo bar qaz *>>| fun x -> hey ho lala - *>>> fun y -> - foo bar qaz +>>| fun x -> hey ho lala +>>> fun y -> return (x, y) + *>>> fun y -> foo bar qaz +>>| fun x -> hey ho lala +>>> fun y -> return (x, y) diff --git a/test/passing/tests/js_fun.ml.ref b/test/passing/refs.ocamlformat/js_fun.ml.ref similarity index 100% rename from test/passing/tests/js_fun.ml.ref rename to test/passing/refs.ocamlformat/js_fun.ml.ref diff --git a/test/passing/refs.ocamlformat/js_map.ml.ref b/test/passing/refs.ocamlformat/js_map.ml.ref new file mode 100644 index 0000000000..f174f4a509 --- /dev/null +++ b/test/passing/refs.ocamlformat/js_map.ml.ref @@ -0,0 +1,2 @@ +let projection_files = + Deferred.List.map x ~f:(fun p -> _) >>| String.split ~on:'\n' diff --git a/test/passing/tests/js_pattern.ml.ref b/test/passing/refs.ocamlformat/js_pattern.ml.ref similarity index 88% rename from test/passing/tests/js_pattern.ml.ref rename to test/passing/refs.ocamlformat/js_pattern.ml.ref index 2a75f4f5b1..cf5f26c2cd 100644 --- a/test/passing/tests/js_pattern.ml.ref +++ b/test/passing/refs.ocamlformat/js_pattern.ml.ref @@ -9,7 +9,8 @@ let f x = match x with _ -> 0 let f x = match x with _ -> 0 let check_price t = function - | {Exec.trade_at_settlement= None | Some false} -> () + | {Exec.trade_at_settlement= None | Some false} -> + () let check_price t = function simpler -> () | other -> () diff --git a/test/passing/tests/js_poly.ml.ref b/test/passing/refs.ocamlformat/js_poly.ml.ref similarity index 100% rename from test/passing/tests/js_poly.ml.ref rename to test/passing/refs.ocamlformat/js_poly.ml.ref diff --git a/test/passing/refs.ocamlformat/js_record.ml.ref b/test/passing/refs.ocamlformat/js_record.ml.ref new file mode 100644 index 0000000000..973c66852a --- /dev/null +++ b/test/passing/refs.ocamlformat/js_record.ml.ref @@ -0,0 +1,50 @@ +type x = {foo: int; bar: int} + +let x = {x with foo= 3; bar= 5} + +let x = + { (* blah blah blah *) + foo= 3 + ; bar= 5 } + +let x = [{x with foo= 3; bar= 5}] + +let x = + [ { (* blah blah blah *) + foo= 3 + ; bar= 5 } ] + +let x = {M.x with M.foo= 3} + +let x = {x with M.foo= 3} + +let x = {M.foo= 3} + +let _ = {foo with Bar.field1= value1; field2= value2} + +let _ = {foo with Bar.field1= value1; field2= value2} + +(* multicomponent record module pathname *) +let _ = {A.B.a= b; c= d} + +type t = {a: something_lengthy list list [@default String.Map.empty]} + +type t = {a: Something_lengthy.t list list [@default String.Map.empty]} + +type t = {a: something_lengthy list list} + +type t = {a: Something_lengthy.t list list} + +type t = {a: Something_lengthy.t list} + +type t = + { for_intf: Dune_rules.Module_name.t list + (* direct module dependencies for the interface *) + ; for_impl: Dune_rules.Module_name.t list + (* direct module dependencies for the implementation *) } + +type t = + { for_intf: Dune_rules.Module_name.t list + (* direct module dependencies for the interface *) + (* direct module dependencies for the interface *) + ; for_impl: Dune_rules.Module_name.t list } diff --git a/test/passing/refs.ocamlformat/js_sig.mli.ref b/test/passing/refs.ocamlformat/js_sig.mli.ref new file mode 100644 index 0000000000..9d1c1ad650 --- /dev/null +++ b/test/passing/refs.ocamlformat/js_sig.mli.ref @@ -0,0 +1,23 @@ +open! Core + +(** First documentation comment. *) +exception First_exception + +(** Second documentation comment. *) +exception Second_exception + +[@@@ocamlformat "parse-docstrings=true"] + +[@@@ocamlformat "wrap-comments=true"] + +(** {e foooooooo oooooo oooo oooo ooooo oooo ooooo} + {i fooooo ooooo ooo oooooo oo oooooo oooo} + {b fooooooo oooooo oooooo oooooo oooooo ooooooo} *) + +(** {e foooooooo oooooooooo ooooooooo ooooooooo} + {{!some ref} fooooooooooooo oooooooo oooooooooo} + {b fooooooooooooo oooooooooooo oooooo ooooooo} *) + +class c : 'a -> object + val x : 'b +end diff --git a/test/passing/refs.ocamlformat/js_source.ml.err b/test/passing/refs.ocamlformat/js_source.ml.err new file mode 100644 index 0000000000..e1daf68e0e --- /dev/null +++ b/test/passing/refs.ocamlformat/js_source.ml.err @@ -0,0 +1,7 @@ +Warning: js_source.ml:121 exceeds the margin +Warning: js_source.ml:137 exceeds the margin +Warning: js_source.ml:146 exceeds the margin +Warning: js_source.ml:153 exceeds the margin +Warning: js_source.ml:224 exceeds the margin +Warning: js_source.ml:627 exceeds the margin +Warning: js_source.ml:827 exceeds the margin diff --git a/test/passing/refs.ocamlformat/js_source.ml.ref b/test/passing/refs.ocamlformat/js_source.ml.ref new file mode 100644 index 0000000000..5780229807 --- /dev/null +++ b/test/passing/refs.ocamlformat/js_source.ml.ref @@ -0,0 +1,846 @@ +(* Signature items *) +module type S = sig + class%foo x : t [@@foo] + + class type%foo x = x [@@foo] +end + +include struct + let%test_module "as" = + ( module struct + let%expect_test + "xx xx xxxxxx xxxxxxx xxxxxx xxxxxx xxxxxxxx xx xxxxx xxx xx xxxxx" = + () + end ) +end +;; + +if fffffffffffffff aaaaa bb then (if b then aaaaaaaaaaaaaaaa ffff) +else aaaaaaaaaaaa qqqqqqqqqqq + +(** @open *) +include Base.Fn + +let ssmap : + (module MapT + with type key = string + and type data = string + and type map = SSMap.map ) = + () + +let ssmap : + (module MapT + with type key = string + and type data = string + and type map = SSMap.map ) + -> unit = + () + +let _ = match x with A -> [%expr match y with e -> e] + +let _ = + match x with A -> [%expr match y with e -> ( match e with x -> x )] + +let _ = + List.map rows ~f:(fun row -> + Or_error.try_with (fun () -> fffffffffffffffffffffffff row) ) + +module type T = sig + val find : t -> key -> value option + (** @raise if not found. *) + + val f : + a_few:params + -> with_long_names:to_break + -> the_line:before_the_comment + -> unit + (** @param blablabla *) +end + +open! Core + +(** First documentation comment. *) +exception First_exception + +(** Second documentation comment. *) +exception Second_exception + +module M = struct + type t + [@@immediate] + (* ______________________________________ *) + [@@deriving variants, sexp_of] +end + +module type Basic3 = sig + type ('a, 'd, 'e) t + + val return : 'a -> ('a, _, _) t + + val apply : ('a -> 'b, 'd, 'e) t -> ('a, 'd, 'e) t -> ('b, 'd, 'e) t + + val map : + [ `Define_using_apply + | `Custom of ('a, 'd, 'e) t -> f:('a -> 'b) -> ('b, 'd, 'e) t ] +end + +let _ = + aa + (bbbbbbbbb cccccccccccc + dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd ) + +let _ = + "_______________________________________________________ \ + _______________________________" + +let _ = + [ very_long_function_name____________________ + very_long_argument_name____________ ] + +(* FIX: exceed 90 columns *) +let _ = + [%str + let () = + very_long_function_name__________________ + very_long_argument_name____________] + +let _ = + { long_field_name= + 9999999999999999999999999999999999999999999999999999999999999999999 } + +(* FIX: exceed 90 columns *) +let _ = + match () with + | _ -> ( + match () with + | _ -> + long_function_name + long_argument_name__________________________________________ ) + +let _ = + aaaaaaa + (* __________________________________________________________________________________ *) + := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + +let g = f ~x (* this is a multiple-line-spanning + comment *) ~y + +let f = + very_long_function_name + ~x:very_long_variable_name + (* this is a multiple-line-spanning + comment *) + ~y + +let _ = + match x with + | { y= + (* _____________________________________________________________________ *) + ( X _ + | Y _ ) } -> + () + +let _ = + match x with + | { y= + ( Z + (* _____________________________________________________________________ *) + | X _ + | Y _ ) } -> + () + +type t = + [ `XXXX + (* __________________________________________________________________________________ *) + | `XXXX + (* __________________________________________________________________ *) + | `XXXX (* _____________________________________________________ *) + | `XXXX (* ___________________________________________________ *) + | `XXXX (* ___________________________________________________ *) + | `XXXX (* ________________________________________________ *) + | `XXXX (* __________________________________________ *) + | `XXXX (* _________________________________________ *) + | `XXXX (* ______________________________________ *) + | `XXXX (* ____________________________________ *) ] + +type t = + { field: ty + (* Here is some verbatim formatted text: + {v + starting at column 7 + v}*) + } + +module Intro_sort = struct + let foo_fooo_foooo fooo ~foooo m1 m2 m3 m4 m5 = + (* Fooooooooooooooooooooooooooo: + {v + 1--o-----o-----o--------------1 + | | | + 2--o-----|--o--|-----o--o-----2 + | | | | | + 3--------o--o--|--o--|--o-----3 + | | | + 4-----o--------o--o--|-----o--4 + | | | + 5-----o--------------o-----o--5 + v} *) + foooooooooo fooooo fooo ; foooooooooo fooooo fooo ; foooooooooo fooooo fooo +end + +let _ = + "_ _____________________ ___________ ________ _____________ ________ \ + _____________ _____\n\n\ + \ ___________________" + +let nullsafe_optimistic_third_party_params_in_non_strict = + CLOpt.mk_bool + ~long:"nullsafe-optimistic-third-party-params-in-non-strict" + (* Turned on for compatibility reasons. Historically this is because + there was no actionable way to change third party annotations. Now + that we have such a support, this behavior should be reconsidered, + provided our tooling and error reporting is friendly enough to be + smoothly used by developers. *) + ~default:true + "Nullsafe: in this mode we treat non annotated third party method params \ + as if they were annotated as nullable." + +let foo () = + if%bind + (* this is a medium length comment of some sort *) + this is a medium length expression of_some sort + then x + else y + +let _ = + match x with + | _ + when f + ~f:(function [@ocaml.warning + (* ....................................... *) "-4"] + | _ -> . ) -> + y + +let[@a + (* .............................................. ........................... .......................... ...................... *) + foo + (* ....................... *) + (* ................................. *) + (* ...................... *)] _ = + match[@ocaml.warning (* ....................................... *) "-4"] + x [@attr (* .......................... .................. *) some_attr] + with + | _ + when f + ~f:(function[@ocaml.warning + (* ....................................... *) "-4"] + | _ -> . ) + ~f:(function[@ocaml.warning + (* ....................................... *) + (* ....................................... *) + "foooooooooooooooooooooooooooo \ + fooooooooooooooooooooooooooooooooooooo"] _ -> . ) + ~f:(function[@ocaml.warning + (* ....................................... *) + let x = a and y = b in + x + y] _ -> . ) -> + y + [@attr + (* ... *) + (* ... *) + attr (* ... *)] + +let x = + foo (`A b) ~f:(fun thing -> + something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs + wrapping ) + +let x = + foo (`A `b) ~f:(fun thing -> + something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs + wrapping ) + +let x = + foo [A; B] ~f:(fun thing -> + something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs + wrapping ) + +let x = + foo [[A]; B] ~f:(fun thing -> + something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs + wrapping ) + +let x = + f + ( "A string _____________________" ^ "Another string _____________" + ^ "Yet another string _________" ) + +let x = + some_fun________________________________ + some_arg______________________________ (fun param -> + do_something () ; do_something_else () ; return_this_value ) + +let x = + some_fun________________________________ + some_arg______________________________ ~f:(fun param -> + do_something () ; do_something_else () ; return_this_value ) + +let x = + some_value + |> some_fun (fun x -> + do_something () ; do_something_else () ; return_this_value ) + +let x = + some_value + ^ some_fun (fun x -> + do_something () ; do_something_else () ; return_this_value ) + +let bind t ~f = + unfold_step + ~f:(function + | Sequence {state= seed; next}, rest -> ( + match next seed with + | Done -> ( + match rest with + | Sequence {state= seed; next} -> ( + match next seed with + | Done -> + Done + | Skip {state= s} -> + Skip {state= (empty, Sequence {state= s; next})} + | Yield {value= a; state= s} -> + Skip {state= (f a, Sequence {state= s; next})} ) ) + | Skip {state= s} -> + Skip {state= (Sequence {state= s; next}, rest)} + | Yield {value= a; state= s} -> + Yield {value= a; state= (Sequence {state= s; next}, rest)} ) ) + ~init:(empty, t) + +let () = + very_long_function_name + ~very_long_argument_label:(fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> () ) + +let () = + ( (one_mississippi, two_mississippi, three_mississippi, four_mississippi) + : Mississippi.t * Mississippi.t * Mississippi.t * Mississippi.t ) + +let _ = (match foo with Bar -> bar | Baz -> baz : string) + +let _ = (match foo with Bar -> bar | Baz -> baz :> string) + +let _ = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + ~bbbbbbbbbbbbbbbbbbbbbbbbbbbb:(fun + (_ : (ccccccccccccc * ddddddddddddddddddddddddddddd) eeee) -> + FFFFFFFFF gg ) + ~h + +type t +[@@deriving + some_deriver_name +, another_deriver_name +, another_deriver_name +, another_deriver_name +, yet_another_such_name +, such_that_they_line_wrap] + +type t +[@@deriving + some_deriver_name another_deriver_name another_deriver_name + another_deriver_name yet_another_such_name such_that_they_line_wrap] + +let pat = + String.Search_pattern.create + (String.init len ~f:(function + | 0 -> + '\n' + | n when n < len - 1 -> + ' ' + | _ -> + '*' )) + +type t = + { break_separators: [`Before | `After] + ; break_sequences: bool + ; break_string_literals: [`Auto | `Never] + (** How to potentially break string literals into new lines. *) + ; break_struct: bool + ; cases_exp_indent: int + ; cases_matching_exp_indent: [`Normal | `Compact] } + +let rec collect_files ~enable_outside_detected_project ~root ~segs ~ignores + ~enables ~files = + match segs with [] | [""] -> (ignores, enables, files, None) + +let _ = + fooooooooooooooooooooooooooooooooooooooo + fooooooooooooooooooooooooooooooooooooooo + fooooooooooooooooooooooooooooooooooooooo + ~f:(fun (type a) foooooooooooooooooooooooooooooooooo : 'a -> + match fooooooooooooooooooooooooooooooooooooooo with + | Fooooooooooooooooooooooooooooooooooooooo -> + x + | Fooooooooooooooooooooooooooooooooooooooo -> + x ) + +let _ = + foo + |> List.map ~f:(fun x -> + do_something () ; + do_something () ; + do_something () ; + do_something () ; + do_something_else () ) + +let _ = + foo + |> List.map ~f:(fun x -> + do_something () ; + do_something () ; + do_something () ; + do_something () ; + do_something_else () ) + |> bar + +let _ = + foo + |> List.map fooooooooooo fooooooooooo fooooooooooo fooooooooooo fooooooooooo + fooooooooooo fooooooooooo fooooooooooo + +let _ = foo |> List.map (function A -> do_something ()) + +let _ = + foo + |> List.map (function + | A -> + do_something () + | A -> + do_something () + | A -> + do_something () + | A -> + do_something () + | A -> + do_something_else () ) + |> bar + +let _ = + foo + |> List.double_map + ~f1:(fun x -> + do_something () ; + do_something () ; + do_something () ; + do_something () ; + do_something_else () ) + ~f2:(fun x -> + do_something () ; + do_something () ; + do_something () ; + do_something () ; + do_something_else () ) + |> bar + +module Stritem_attributes_indent : sig + val f : int -> int -> int -> int -> int + [@@cold] [@@inline never] [@@local never] [@@specialise never] + + external unsafe_memset : t -> pos:int -> len:int -> char -> unit + = "bigstring_memset_stub" + [@@noalloc] +end = struct + let raise_length_mismatch name n1 n2 = + invalid_argf "length mismatch in %s: %d <> %d" name n1 n2 () + [@@cold] [@@inline never] [@@local never] [@@specialise never] + + external unsafe_memset : t -> pos:int -> len:int -> char -> unit + = "bigstring_memset_stub" + [@@noalloc] +end + +let _ = + foo + $$ ( match group with + | [] -> + impossible "previous match" + | [cmt] -> + fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt ) + $$ bar + +let _ = + foo + $$ ( try group with + | [] -> + impossible "previous match" + | [cmt] -> + fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt ) + $$ bar + +let _ = + x == exp + || + match x with {pexp_desc= Pexp_constraint (e, _); _} -> loop e | _ -> false + +let _ = + let module M = struct + include + ( val foooooooooooooooooooooooooooooooooooooooo + : fooooooooooooooooooooooooooooooooooooooooo ) + end in + () + +type action = + | In_out of [`Impl | `Intf] input * string option + (** Format input file (or [-] for stdin) of given kind to output file, + or stdout if None. *) + (* foo *) + | Inplace of [`Impl | `Intf] input list + (** Format in-place, overwriting input file(s). *) + +let%test_module "semantics" = + ( module ( + struct + open Core + open Appendable_list + module Stable = Stable + end : + S ) ) + +let _ = + Error + (`Foooooooooooooooooo + (name, Format.sprintf "expecting %S but got %S" Version.version value) ) + +let _ = + `Foooooooooooooooooo + (name, Format.sprintf "expecting %S but got %S" Version.version value) + +let _ = + Foooooooooooooooooo + (name, Format.sprintf "expecting %S but got %S" Version.version value) + +let (`Foooooooooooooooooo + (foooooooooooooo, foooooooooooooo, foooooooooooooo, foooooooooooooo) ) = + x + +let (Foooooooooooooooooo + (foooooooooooooo, foooooooooooooo, foooooooooooooo, foooooooooooooo) ) = + x + +let _ = + Foooooooooooooooooooo.foooooooooooooooooooo foooooooooooooooooooo + foooooooooooooooooooo (fun x -> function + | Foooooooooooooooooooo -> + foooooooooooooooooooo + | Foooooooooooooooooooo -> + foooooooooooooooooooo ) + +let _ = + Foooooooooooooooooooo.foooooooooooooooooooo foooooooooooooooooooo + foooooooooooooooooooo ~x:(fun x -> function + | Foooooooooooooooooooo -> + foooooooooooooooooooo + | Foooooooooooooooooooo -> + foooooooooooooooooooo ) + +let _ = + Foooooooooooooooooooo.foooooooooooooooooooo foooooooooooooooooooo + foooooooooooooooooooo (fun x -> + match foo with + | Foooooooooooooooooooo -> + foooooooooooooooooooo + | Foooooooooooooooooooo -> + foooooooooooooooooooo ) + +let _ = + Foooooooooooooooooooo.foooooooooooooooooooo foooooooooooooooooooo + foooooooooooooooooooo ~x:(fun x -> + match foo with + | Foooooooooooooooooooo -> + foooooooooooooooooooo + | Foooooooooooooooooooo -> + foooooooooooooooooooo ) + +let _ = + let x = x in + fun foooooooooooooooooo foooooooooooooooooo foooooooooooooooooo + foooooooooooooooooo foooooooooooooooooo foooooooooooooooooo -> () + +module type For_let_syntax_local = + For_let_syntax_gen + with type ('a, 'b) fn := ('a[@local]) -> 'b + and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b + +type fooooooooooooooooooooooooooooooo = + ( fooooooooooooooooooooooooooooooo + , fooooooooooooooooooooooooooooooo ) + fooooooooooooooooooooooooooooooo + +val fooooooooooooooooooooooooooooooo : + ( fooooooooooooooooooooooooooooooo + , fooooooooooooooooooooooooooooooo ) + fooooooooooooooooooooooooooooooo + +(* *) + +(** + xxx +*) +include S1 +(** @inline *) + +type input = {name: string; action: [`Format | `Numeric of range]} + +let x = + fun [@foo] x -> + fun [@foo] y -> + object + method x = y + end + +class x = + fun [@foo] x -> + fun [@foo] y -> + object + method x = y + end + +module M = + [%demo + module Foo = Bar + + type t] + +let _ = + Some + (fun fooooooooooooooooooooooooooooooo + fooooooooooooooooooooooooooooooo + fooooooooooooooooooooooooooooooo + -> foo ) + +type t = + { xxxxxx: + t + (* _________________________________________________________________________ + ____________________________________________________________________ + ___________ *) + XXXXXXX.t } + +module Test_gen + (For_tests : For_tests_gen) + (Tested : + S_gen + with type 'a src := 'a For_tests.Src.t + with type 'a dst := 'a For_tests.Dst.t) + (Tested : + S_gen + with type 'a src := 'a For_tests.Src.t + with type 'a dst := 'a For_tests.Dst.t + and type 'a dst := 'a For_tests.Dst.t + and type 'a dst := 'a For_tests.Dst.t) = +struct + open Tested + open For_tests +end + +type t = + { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx: + YYYYYYYYYYYYYYYYYYYYY.t + (* ____________________________________ *) } + +(*{v + + foo + +v}*) + +(*$ {| + f|} *) + +type t = + { xxxxxxxxxxxxxxxxxxx: yyy + [@zzzzzzzzzzzzzzzzzzz + (* ________________________________ + ___ *) + _______] } + +let _ = + match () with + (*$ Printf.(printf "\n | _ -> .\n;;\n") *) + | _ -> + . + +(*$*) + +(*$ "________________________" $*) + +(*$ + let open! Core in + () +*) +(*$*) + +(*$ + [%string + {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +zzzzzzzzzzzzzzzzzzzzzzzzzzzz + |}] +*) +(*$*) + +(*$ {| + f|} *) + +let () = match () with _ -> ( fun _ : _ -> match () with _ -> () ) | _ -> () + +(* ocp-indent-compat: Docked fun after apply only if on the same line. *) + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo:(fun foo -> bar ) + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo:(fun foo -> bar) + ~fooooooooooooooooooooooooooooooo + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo:(fun foo -> + match bar with Some _ -> foo | None -> baz ) + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo + (fun foo -> bar ) + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo + (fun foo -> match bar with Some _ -> foo | None -> baz ) + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo + ~fooooooooooooooooooooooooooooooo (fun foo -> + match bar with Some _ -> foo | None -> baz ) + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooofooooooooooooooooooooooooooooooofoooooooooo + (fun foo -> match bar with Some _ -> foo | None -> baz ) + +let _ = + fooooooooooooooooooooooooooooooo + |> foooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo (function + | foo -> bar ) + +let _ = + fooooooooooooooooooooooooooooooo + |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo + (function + | Some _ -> + foo + | None -> + baz ) + +(* *) + +(*$ (* *) *) + +(** xxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx + xxxx] xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx] *) + +(* Hand-aligned comment + . + . *) + +(* First line is indented more + . + . *) + +module type M = sig + val imported_sets_of_closures_table : + Simple_value_approx.function_declarations option + Set_of_closures_id.Tbl.fooooooooooooooooooooooooo +end + +(*$ let _ = [x (* *); y] *) + +let _ = + { foo= + (fun _ -> function + | _ -> + let _ = 42 in + () + | () -> + () ) } + +let _ = + match () with + | _ -> ( + f + >>= function + | `Fooooooooooooooooooooooooooooooooooooooo -> + 1 + | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> + 2 ) + +let _ = + match () with + | _ -> + f + >>= (function + | `Fooooooooooooooooooooooooooooooooooooooo -> + 1 + | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> + 2 ) + >>= foo + +let exists t key = + S.Tree.kind t.tree (path key) + >|= function + | Some `Contents -> + Ok (Some `Value) + | Some `Node -> + Ok (Some `Dictionary) + | None -> + Ok None + +let _ = if x then 42 (* dummy *) else y + +let _ = if x then 42 (* dummy *) else if y then z else w + +let _ = + if x then fun _ -> true + (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) + else f + +let _ = + match ids_queue with + | Some q -> + (* this is more efficient than a linear scan of [ids] *) + fun id -> not (Ident.HashQueue.mem q id) + | None -> + fun id -> not (List.mem ~equal:Ident.equal ids id) + +type callbacks = + { html_debug_new_node_session_f: + 'a. + ?kind:[`ComputePre | `ExecNode | `ExecNodeNarrowing | `WTO] + -> pp_name:(Format.formatter -> unit) + -> Procdesc.Node.t + -> f:(unit -> 'a) + -> 'a } diff --git a/test/passing/tests/js_syntax.ml.ref b/test/passing/refs.ocamlformat/js_syntax.ml.ref similarity index 100% rename from test/passing/tests/js_syntax.ml.ref rename to test/passing/refs.ocamlformat/js_syntax.ml.ref diff --git a/test/passing/tests/js_to_do.ml.ref b/test/passing/refs.ocamlformat/js_to_do.ml.ref similarity index 59% rename from test/passing/tests/js_to_do.ml.ref rename to test/passing/refs.ocamlformat/js_to_do.ml.ref index 3917f02f27..dd41e32098 100644 --- a/test/passing/tests/js_to_do.ml.ref +++ b/test/passing/refs.ocamlformat/js_to_do.ml.ref @@ -14,29 +14,28 @@ let _ = (* js-type *) (* The following tests incorporate several subtle and different indentation - ideas. Please consider this only a proposal for discussion, for now. + ideas. Please consider this only a proposal for discussion, for now. First, notice the display treatment of "(,)" tuples, analogous to "[;]" - lists. While "(,)" is an intensional combination of "()" and ",", unlike - "[;]" lists, we believe "(,)" isn't too big a departure. Value expression + lists. While "(,)" is an intensional combination of "()" and ",", unlike + "[;]" lists, we believe "(,)" isn't too big a departure. Value expression analogies are included in js-type.ml, (meant to be) consistent with the proposed type indentation. - Second, and more divergently, the proposed indentation of function types - is based on the idea of aligning the arguments, even the first argument, - even where that means automatically inserting spaces within lines. This - applies to the extra spaces in ":__unit" and "(____Config.Network.t" - below. + Second, and more divergently, the proposed indentation of function types is + based on the idea of aligning the arguments, even the first argument, even + where that means automatically inserting spaces within lines. This applies + to the extra spaces in ":__unit" and "(____Config.Network.t" below. We believe this fits into a more general incorporation of alignment into - ocp-indent, to replace our internal alignment tool with a syntax-aware - one. We like to align things for readability, like big records, record - types, lists used to build tables, etc. + ocp-indent, to replace our internal alignment tool with a syntax-aware one. + We like to align things for readability, like big records, record types, + lists used to build tables, etc. - The proposal also includes indenting "->" in the circumstances below - relative to the enclosing "()", by two spaces. In a sense, this happens - first, and then the first argument is aligned accordingly. So, there's no - manual indentation or spacing below. *) + The proposal also includes indenting "->" in the circumstances below relative + to the enclosing "()", by two spaces. In a sense, this happens first, and + then the first argument is aligned accordingly. So, there's no manual + indentation or spacing below. *) val instances : unit @@ -59,9 +58,6 @@ val instances : (* presumed analog with stars *) val instances : unit - * ( Config.Network.t - * (App.t * Config.instance * Config.app) list - * bool - * 'm + * ( Config.Network.t * (App.t * Config.instance * Config.app) list * bool * 'm , 'm ) Command.Spec.t diff --git a/test/passing/tests/js_upon.ml.ref b/test/passing/refs.ocamlformat/js_upon.ml.ref similarity index 78% rename from test/passing/tests/js_upon.ml.ref rename to test/passing/refs.ocamlformat/js_upon.ml.ref index 87df8ba5cb..5ee5ad8c31 100644 --- a/test/passing/tests/js_upon.ml.ref +++ b/test/passing/refs.ocamlformat/js_upon.ml.ref @@ -1,14 +1,14 @@ let f x = stop - (* We don't do this as a matter of style, but the indentation reveals a - common mistake. *) + (* We don't do this as a matter of style, but the indentation reveals a common + mistake. *) >>> fun () -> don't_wait_for (close fd) ; bind fd let f x = ( stop - (* This is what was intended, which is indented correctly, although it's - bad style on my part. *) + (* This is what was intended, which is indented correctly, although it's bad + style on my part. *) >>> fun () -> don't_wait_for (close fd) ) ; bind diff --git a/test/passing/refs.ocamlformat/kw_extentions.ml.ref b/test/passing/refs.ocamlformat/kw_extentions.ml.ref new file mode 100644 index 0000000000..302c43c658 --- /dev/null +++ b/test/passing/refs.ocamlformat/kw_extentions.ml.ref @@ -0,0 +1,52 @@ +let _ = + let%lwt foo = Lwt.return 1 in + Lwt.return_unit + +let _ = + let%lwt foo = Lwt.return 1 in + let%lwt bar = Lwt.return 1 in + let%lwt baz = Lwt.return 1 in + Lwt.return_unit + +let () = + if%ext true then () else () ; + if%ext true then () else if true then () else () ; + let%ext x = () in + for%ext i = 1 to 10 do + () + done ; + while%ext false do + () + done ; + match%ext x with _ -> () + +let () = + let%ext x = () in + try%ext x with _ -> () + +let () = + if%ext true then () else () ; + if%ext true then () else if true then () else () ; + if%ext true then () else () + +let () = + (match%ext x with _ -> ()) ; + match%ext x with _ -> () + +let () = () ; () ;%ext () ; () ;%ext () + +let _ = + let%ext () = () and () = () in + () + +let () = + f (fun () -> ()) ;%ext + f () + +let () = + f (fun () -> ()) ;%ext + g (fun () -> ()) ; + h (fun () -> ()) ;%ext + i () ; + j () ;%ext + f () diff --git a/test/passing/tests/label_option_default_args.ml.ref b/test/passing/refs.ocamlformat/label_option_default_args.ml.ref similarity index 98% rename from test/passing/tests/label_option_default_args.ml.ref rename to test/passing/refs.ocamlformat/label_option_default_args.ml.ref index 0f3af3adea..e16b3848ba 100644 --- a/test/passing/tests/label_option_default_args.ml.ref +++ b/test/passing/refs.ocamlformat/label_option_default_args.ml.ref @@ -17,14 +17,13 @@ let (* 0 *) f (* 1 *) ~l:(* 2 *) x (* 3 *) = (* 4 *) e let f ~l:{f; g} = e -let (* 0 *) f (* 1 *) ~l:(* 2 *) {(* 3 *) f (* 4 *); (* 5 *) g (* 6 *)} - (* 7 *) = +let (* 0 *) f (* 1 *) ~l:(* 2 *) {(* 3 *) f (* 4 *); (* 5 *) g (* 6 *)} (* 7 *) + = e let f ~x:({f; g} as x) = e -let (* 0 *) f (* 1 *) ~x:((* 2 *) {f; g} (* 3 *) as (* 4 *) x (* 5 *)) - (* 6 *) = +let (* 0 *) f (* 1 *) ~x:((* 2 *) {f; g} (* 3 *) as (* 4 *) x (* 5 *)) (* 6 *) = e let f ?x = e diff --git a/test/passing/tests/labelled_args-414.ml.ref b/test/passing/refs.ocamlformat/labelled_args-414.ml.ref similarity index 100% rename from test/passing/tests/labelled_args-414.ml.ref rename to test/passing/refs.ocamlformat/labelled_args-414.ml.ref diff --git a/test/passing/refs.ocamlformat/labelled_args.ml.ref b/test/passing/refs.ocamlformat/labelled_args.ml.ref new file mode 100644 index 0000000000..d0a6ad47b9 --- /dev/null +++ b/test/passing/refs.ocamlformat/labelled_args.ml.ref @@ -0,0 +1,39 @@ +let _ = + let f ~y = y + 1 in + f ~y:(y : int) + +let () = + very_long_function_name + ~very_long_argument_label:(fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> () ) + +let () = + very_long_function_name + ~very_long_argument_label:(* foo *) + (fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> () ) + +let () = + very_long_function_name + ~very_long_argument_label:(fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> () ) + foo + +let () = + very_long_function_name + ~very_long_argument_label:(* foo *) + (fun + very_long_argument_name_one + very_long_argument_name_two + very_long_argument_name_three + -> () ) + foo diff --git a/test/passing/refs.ocamlformat/lazy.ml.ref b/test/passing/refs.ocamlformat/lazy.ml.ref new file mode 100644 index 0000000000..6b650df88f --- /dev/null +++ b/test/passing/refs.ocamlformat/lazy.ml.ref @@ -0,0 +1,18 @@ +let (lazy a) = lazy 1 + +let (lazy (a, b)) = lazy (1, 2) + +let () = + let (lazy a) = lazy 1 in + let (lazy (a, b)) = lazy (1, 2) in + () + +let _ = lazy (a.b <- 1) + +let _ = match x with (lazy (Some _ as x)), x -> x + +let _ = + lazy + ((let () = () in + () ) + [@attr] ) diff --git a/test/passing/tests/let_binding-deindent-fun.ml.ref b/test/passing/refs.ocamlformat/let_binding-deindent-fun.ml.ref similarity index 88% rename from test/passing/tests/let_binding-deindent-fun.ml.ref rename to test/passing/refs.ocamlformat/let_binding-deindent-fun.ml.ref index 84e43e1975..b0d7326d4b 100644 --- a/test/passing/tests/let_binding-deindent-fun.ml.ref +++ b/test/passing/refs.ocamlformat/let_binding-deindent-fun.ml.ref @@ -40,15 +40,18 @@ let f : 'a. 'a ty -> 'a = fun y -> g y let f (A _ | B | C) = () let f - ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ | BBBBBBBBBBBBBBBBBBBBBbb + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ + | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = () let f ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa - ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe | FFFFFFFFFFFFFFFFFFFFFFFFFFf + ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe + | FFFFFFFFFFFFFFFFFFFFFFFFFFf | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) - | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + | BBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCCCCCCCCCCCCCCCCCccccc ) = () let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () @@ -58,8 +61,11 @@ let f = function AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () let f = function EEEEEEE | F | GGGGG | B | CCCCCCC -> () let f = function - | EEEEEEE | FFFFFFFFFFFFFFFFFFFFFFF | GGGGG - |BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb | CCCCCCC -> + | EEEEEEE + | FFFFFFFFFFFFFFFFFFFFFFF + | GGGGG + | BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCC -> () let (_ : t -> t -> int) = (compare : int list -> int list -> int) @@ -181,7 +187,8 @@ let _ = | a -> ( let+ a = b in match a with a -> a ) - | b -> c ) + | b -> + c ) let _ = let+ a b = c in @@ -264,8 +271,7 @@ let a, b = (raise Exit : int * int) let a, b = (raise Exit : int * int) let _ = - fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : - _ -> + fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> match () with _ -> () ;; @@ -273,8 +279,13 @@ fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> match () with _ -> () let _ = - (* An alternative would be to track 'mutability of the field' directly. *) + (* + An alternative would be to track 'mutability of the field' + directly. + *) function - | Strict | Alias -> Immutable - | StrictOpt -> Mutable + | Strict | Alias -> + Immutable + | StrictOpt -> + Mutable ;; diff --git a/test/passing/tests/let_binding-in_indent.ml.ref b/test/passing/refs.ocamlformat/let_binding-in_indent.ml.ref similarity index 89% rename from test/passing/tests/let_binding-in_indent.ml.ref rename to test/passing/refs.ocamlformat/let_binding-in_indent.ml.ref index b85987d3b0..85967981c5 100644 --- a/test/passing/tests/let_binding-in_indent.ml.ref +++ b/test/passing/refs.ocamlformat/let_binding-in_indent.ml.ref @@ -40,15 +40,18 @@ let f : 'a. 'a ty -> 'a = fun y -> g y let f (A _ | B | C) = () let f - ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ | BBBBBBBBBBBBBBBBBBBBBbb + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ + | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = () let f ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa - ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe | FFFFFFFFFFFFFFFFFFFFFFFFFFf + ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe + | FFFFFFFFFFFFFFFFFFFFFFFFFFf | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) - | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + | BBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCCCCCCCCCCCCCCCCCccccc ) = () let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () @@ -58,8 +61,11 @@ let f = function AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () let f = function EEEEEEE | F | GGGGG | B | CCCCCCC -> () let f = function - | EEEEEEE | FFFFFFFFFFFFFFFFFFFFFFF | GGGGG - |BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb | CCCCCCC -> + | EEEEEEE + | FFFFFFFFFFFFFFFFFFFFFFF + | GGGGG + | BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCC -> () let (_ : t -> t -> int) = (compare : int list -> int list -> int) @@ -181,7 +187,8 @@ let _ = | a -> ( let+ a = b in match a with a -> a ) - | b -> c ) + | b -> + c ) let _ = let+ a b = c in @@ -272,8 +279,13 @@ fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> match () with _ -> () let _ = - (* An alternative would be to track 'mutability of the field' directly. *) + (* + An alternative would be to track 'mutability of the field' + directly. + *) function - | Strict | Alias -> Immutable - | StrictOpt -> Mutable + | Strict | Alias -> + Immutable + | StrictOpt -> + Mutable ;; diff --git a/test/passing/tests/let_binding-indent.ml.ref b/test/passing/refs.ocamlformat/let_binding-indent.ml.ref similarity index 87% rename from test/passing/tests/let_binding-indent.ml.ref rename to test/passing/refs.ocamlformat/let_binding-indent.ml.ref index ad31bca71c..334bb9a643 100644 --- a/test/passing/tests/let_binding-indent.ml.ref +++ b/test/passing/refs.ocamlformat/let_binding-indent.ml.ref @@ -40,15 +40,18 @@ let f : 'a. 'a ty -> 'a = fun y -> g y let f (A _ | B | C) = () let f - ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ | BBBBBBBBBBBBBBBBBBBBBbb + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ + | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = () let f ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa - ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe | FFFFFFFFFFFFFFFFFFFFFFFFFFf + ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe + | FFFFFFFFFFFFFFFFFFFFFFFFFFf | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) - | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + | BBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCCCCCCCCCCCCCCCCCccccc ) = () let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () @@ -58,8 +61,11 @@ let f = function AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () let f = function EEEEEEE | F | GGGGG | B | CCCCCCC -> () let f = function - | EEEEEEE | FFFFFFFFFFFFFFFFFFFFFFF | GGGGG - |BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb | CCCCCCC -> + | EEEEEEE + | FFFFFFFFFFFFFFFFFFFFFFF + | GGGGG + | BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCC -> () let (_ : t -> t -> int) = (compare : int list -> int list -> int) @@ -107,8 +113,8 @@ let f aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc () let _ = - fun aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb - cccccccccccccccccccccccc dddddddddddddddddd eeeeeeeeeeeeee -> + fun aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc + dddddddddddddddddd eeeeeeeeeeeeee -> () let _ = @@ -181,7 +187,8 @@ let _ = | a -> ( let+ a = b in match a with a -> a ) - | b -> c ) + | b -> + c ) let _ = let+ a b = c in @@ -273,8 +280,13 @@ fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> match () with _ -> () let _ = - (* An alternative would be to track 'mutability of the field' directly. *) + (* + An alternative would be to track 'mutability of the field' + directly. + *) function - | Strict | Alias -> Immutable - | StrictOpt -> Mutable + | Strict | Alias -> + Immutable + | StrictOpt -> + Mutable ;; diff --git a/test/passing/tests/let_binding.ml.ref b/test/passing/refs.ocamlformat/let_binding.ml.ref similarity index 88% rename from test/passing/tests/let_binding.ml.ref rename to test/passing/refs.ocamlformat/let_binding.ml.ref index 347af03abc..15841a3a9e 100644 --- a/test/passing/tests/let_binding.ml.ref +++ b/test/passing/refs.ocamlformat/let_binding.ml.ref @@ -40,15 +40,18 @@ let f : 'a. 'a ty -> 'a = fun y -> g y let f (A _ | B | C) = () let f - ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ | BBBBBBBBBBBBBBBBBBBBBbb + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ + | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = () let f ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa - ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe | FFFFFFFFFFFFFFFFFFFFFFFFFFf + ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe + | FFFFFFFFFFFFFFFFFFFFFFFFFFf | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) - | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + | BBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCCCCCCCCCCCCCCCCCccccc ) = () let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () @@ -58,8 +61,11 @@ let f = function AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () let f = function EEEEEEE | F | GGGGG | B | CCCCCCC -> () let f = function - | EEEEEEE | FFFFFFFFFFFFFFFFFFFFFFF | GGGGG - |BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb | CCCCCCC -> + | EEEEEEE + | FFFFFFFFFFFFFFFFFFFFFFF + | GGGGG + | BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCC -> () let (_ : t -> t -> int) = (compare : int list -> int list -> int) @@ -181,7 +187,8 @@ let _ = | a -> ( let+ a = b in match a with a -> a ) - | b -> c ) + | b -> + c ) let _ = let+ a b = c in @@ -272,8 +279,13 @@ fun xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : _ -> match () with _ -> () let _ = - (* An alternative would be to track 'mutability of the field' directly. *) + (* + An alternative would be to track 'mutability of the field' + directly. + *) function - | Strict | Alias -> Immutable - | StrictOpt -> Mutable + | Strict | Alias -> + Immutable + | StrictOpt -> + Mutable ;; diff --git a/test/passing/tests/let_binding_spacing-double-semicolon.ml.ref b/test/passing/refs.ocamlformat/let_binding_spacing-double-semicolon.ml.ref similarity index 100% rename from test/passing/tests/let_binding_spacing-double-semicolon.ml.ref rename to test/passing/refs.ocamlformat/let_binding_spacing-double-semicolon.ml.ref diff --git a/test/passing/tests/let_binding_spacing-sparse.ml.ref b/test/passing/refs.ocamlformat/let_binding_spacing-sparse.ml.ref similarity index 100% rename from test/passing/tests/let_binding_spacing-sparse.ml.ref rename to test/passing/refs.ocamlformat/let_binding_spacing-sparse.ml.ref diff --git a/test/passing/refs.ocamlformat/let_binding_spacing.ml.ref b/test/passing/refs.ocamlformat/let_binding_spacing.ml.ref new file mode 100644 index 0000000000..a01604327a --- /dev/null +++ b/test/passing/refs.ocamlformat/let_binding_spacing.ml.ref @@ -0,0 +1,17 @@ +let f x = x + +and g x = x + +let f x = x + +and g : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = fun h a b -> h + +and g : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = + fun h a b -> h (i a) (i b) (i c) + +let f x = x + +let f : 'a. (_ -> _ -> _ -> 'a) -> _ -> _ -> _ -> 'a = + fun h a b -> h (i a) (i b) (i c) + +let f x = x diff --git a/test/passing/refs.ocamlformat/let_in_constr.ml.ref b/test/passing/refs.ocamlformat/let_in_constr.ml.ref new file mode 100644 index 0000000000..543a87ac81 --- /dev/null +++ b/test/passing/refs.ocamlformat/let_in_constr.ml.ref @@ -0,0 +1,4 @@ +let _ = + Some + (let open! List in + 1 ) diff --git a/test/passing/tests/let_module-sparse.ml.ref b/test/passing/refs.ocamlformat/let_module-sparse.ml.ref similarity index 97% rename from test/passing/tests/let_module-sparse.ml.ref rename to test/passing/refs.ocamlformat/let_module-sparse.ml.ref index 225ce4e31e..f247199d67 100644 --- a/test/passing/tests/let_module-sparse.ml.ref +++ b/test/passing/refs.ocamlformat/let_module-sparse.ml.ref @@ -70,7 +70,7 @@ let f () = let module (* multi-line - comment *) + comment *) M = struct end in () diff --git a/test/passing/tests/let_module.ml.ref b/test/passing/refs.ocamlformat/let_module.ml.ref similarity index 97% rename from test/passing/tests/let_module.ml.ref rename to test/passing/refs.ocamlformat/let_module.ml.ref index 08a236e77a..0113ec8bcd 100644 --- a/test/passing/tests/let_module.ml.ref +++ b/test/passing/refs.ocamlformat/let_module.ml.ref @@ -62,7 +62,7 @@ let f () = let module (* multi-line - comment *) + comment *) M = struct end in () diff --git a/test/passing/refs.ocamlformat/let_punning.ml.ref b/test/passing/refs.ocamlformat/let_punning.ml.ref new file mode 100644 index 0000000000..5d3a36cb79 --- /dev/null +++ b/test/passing/refs.ocamlformat/let_punning.ml.ref @@ -0,0 +1,17 @@ +let ( let* ) x f = f x + +let ( and* ) a b = (a, b) + +let x = 1 + +and y = 2 + +and z = 3 + +let p = + let* x = x and* y = y and* z = z in + (x, y, z) + +let q = + let%foo x = x and y = y and z = z in + (x, y, z) diff --git a/test/passing/refs.ocamlformat/line_directives.ml.err b/test/passing/refs.ocamlformat/line_directives.ml.err new file mode 100644 index 0000000000..45382a4f00 --- /dev/null +++ b/test/passing/refs.ocamlformat/line_directives.ml.err @@ -0,0 +1,5 @@ +ocamlformat: ignoring "line_directives.ml" (syntax error) +File "line_directives.ml", line 1, characters 1-9: +1 | #3 "f.ml" + ^^^^^^^^ +Error: Invalid lexer directive "#3 \"f.ml\"": line directives are not supported diff --git a/test/passing/tests/list-space_around.ml.ref b/test/passing/refs.ocamlformat/list-space_around.ml.ref similarity index 100% rename from test/passing/tests/list-space_around.ml.ref rename to test/passing/refs.ocamlformat/list-space_around.ml.ref diff --git a/test/passing/refs.ocamlformat/list.ml.ref b/test/passing/refs.ocamlformat/list.ml.ref new file mode 100644 index 0000000000..46f7128faf --- /dev/null +++ b/test/passing/refs.ocamlformat/list.ml.ref @@ -0,0 +1,88 @@ +let f x = match x with P ({xxxxxx} :: {yyyyyyyy} :: zzzzzzz) -> true + +let f x = + match x with + | P + ( {xxxxxxxxxxxxxxxxxxxxxx} + :: {yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy} + :: zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz ) -> + true + +let f x = match x with P [{xxxxxx}; {yyyyyyyy}] -> true + +let x = (x :: y) :: z + +let x = match x with (x :: y) :: z -> () + +let _ = [a; b; c] + +let _ = match x with Atom x -> x | List [Atom x; Atom y] -> x ^ y + +let _ = match x with Atom x -> x | List (Atom x :: Atom y :: rest) -> x ^ y + +let _ = match x with (x :: y) :: z -> true + +let x = function + | [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" + ; [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" + ; (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *) ] + ; (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *) ] -> + () + +[@@@ocamlformat "space-around-lists=true"] + +let x = function + | [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" + ; [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" + ; (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *) + ] + ; (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *) + ] -> + () + | [ [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit" ] + ; (* ", sed do eiusmod tempor incididunt ut labore et dolore"; *) + "sed do eiusmod tempor incididunt ut labore et dolore" + (* " magna aliqua. Ut enim ad minim veniam, quis nostrud "; *) + (* "exercitation ullamco laboris nisi ut aliquip ex ea commodo " *) + ] -> + () + +let _ = f (* A *) ~x:(a :: b) (* B *) ~y + +let _ = f (* A *) ~x:((* B *) a :: b (* C *)) (* D *) ~y + +let _ = f ~x:((* A *) a (* B *) :: (* C *) b (* D *) :: (* E *) c (* F *)) ~y + +let _ = f ((* A *) x (* B *) :: (* C *) y (* D *) :: (* E *) z (* F *)) + +let _ = abc :: (* def :: *) ghi :: jkl + +let _ = abc :: def (* :: ghi *) :: jkl + +let _ = (c :: l1) @ foo (l2 @ l) + +let _ = + make_single_trace create_loc message + :: make_single_trace create_loc create_message + :: List.map call_chain ~f:(fun foooooooooooooooooooooooooooo -> + fooooooooooooooooooooooooooooooo foooooooooooo [] ) + :: foooooooo :: fooooooooooooooooo + +let _ = + fooooooo + ( mk_var i (tfo_combine (nuc_p_o3'_60_tfo n) align) n + :: mk_var i (tfo_combine (nuc_p_o3'_180_tfo n) align) n + :: mk_var i (tfo_combine (nuc_p_o3'_275_tfo n) align) n + :: domains ) diff --git a/test/passing/tests/list_and_comments.ml.ref b/test/passing/refs.ocamlformat/list_and_comments.ml.ref similarity index 100% rename from test/passing/tests/list_and_comments.ml.ref rename to test/passing/refs.ocamlformat/list_and_comments.ml.ref diff --git a/test/passing/tests/list_normalized.ml.ref b/test/passing/refs.ocamlformat/list_normalized.ml.ref similarity index 90% rename from test/passing/tests/list_normalized.ml.ref rename to test/passing/refs.ocamlformat/list_normalized.ml.ref index 5ac9774761..1112bf3b6b 100644 --- a/test/passing/tests/list_normalized.ml.ref +++ b/test/passing/refs.ocamlformat/list_normalized.ml.ref @@ -13,8 +13,7 @@ let x = (* f *) (* comments preserved when the normalization cannot be done (attributes) *) -let x = - (* a *) 1 (* b *) :: (* c *) 2 :: 3 :: 4 (* d *) :: (* e *) ([] [@attr]) +let x = (* a *) 1 (* b *) :: (* c *) 2 :: 3 :: 4 (* d *) :: (* e *) ([] [@attr]) (* f *) (* comments preserved when no normalization required *) diff --git a/test/passing/tests/loc_stack.ml.ref b/test/passing/refs.ocamlformat/loc_stack.ml.ref similarity index 62% rename from test/passing/tests/loc_stack.ml.ref rename to test/passing/refs.ocamlformat/loc_stack.ml.ref index 7fdb6ca6c3..51fcaaaf75 100644 --- a/test/passing/tests/loc_stack.ml.ref +++ b/test/passing/refs.ocamlformat/loc_stack.ml.ref @@ -6,7 +6,8 @@ let _ = let _ = (* before match *) match (* after match *) x with - | _ -> 1 + | _ -> + 1 let _ = (* before try *) @@ -24,9 +25,23 @@ let should_inline : Llvm.llvalue -> bool = build contexts *) match Llvm.classify_value llv with | Instruction - ( Trunc | ZExt | SExt | FPToUI | FPToSI | UIToFP | SIToFP | FPTrunc - | FPExt | PtrToInt | IntToPtr | BitCast | AddrSpaceCast ) -> + ( Trunc + | ZExt + | SExt + | FPToUI + | FPToSI + | UIToFP + | SIToFP + | FPTrunc + | FPExt + | PtrToInt + | IntToPtr + | BitCast + | AddrSpaceCast ) -> true (* inline casts *) - | _ -> false (* do not inline if >= 2 uses *) ) - | None -> true ) - | None -> true + | _ -> + false (* do not inline if >= 2 uses *) ) + | None -> + true ) + | None -> + true diff --git a/test/passing/refs.ocamlformat/locally_abtract_types.ml.ref b/test/passing/refs.ocamlformat/locally_abtract_types.ml.ref new file mode 100644 index 0000000000..121fb8b97e --- /dev/null +++ b/test/passing/refs.ocamlformat/locally_abtract_types.ml.ref @@ -0,0 +1,11 @@ +let f (type v) (x : v) = x + +let f (type v) (x : v) : unit = () + +let f : type s. s t -> s = function X x -> x | Y y -> y + +let x = (fun (type a) x -> x) () + +let x = (fun x (type a b c) x -> x) () + +let f = function T x -> (fun (type a) (x : a t) -> x) x diff --git a/test/passing/refs.ocamlformat/margin_80.ml.err b/test/passing/refs.ocamlformat/margin_80.ml.err new file mode 100644 index 0000000000..ea16d07780 --- /dev/null +++ b/test/passing/refs.ocamlformat/margin_80.ml.err @@ -0,0 +1,2 @@ +Warning: margin_80.ml:7 exceeds the margin +Warning: margin_80.ml:11 exceeds the margin diff --git a/test/passing/tests/margin_80.ml.ref b/test/passing/refs.ocamlformat/margin_80.ml.ref similarity index 100% rename from test/passing/tests/margin_80.ml.ref rename to test/passing/refs.ocamlformat/margin_80.ml.ref diff --git a/test/passing/refs.ocamlformat/match.ml.ref b/test/passing/refs.ocamlformat/match.ml.ref new file mode 100644 index 0000000000..e3d56da951 --- /dev/null +++ b/test/passing/refs.ocamlformat/match.ml.ref @@ -0,0 +1,77 @@ +let _ = match a with A -> ( match b with B -> b | C -> c ) | D -> D + +let _ = + match a with + | AAAAAAAAAA -> ( + match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> + bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> + ccccccccccccccccc ) + | DDDDDDDDDDDDDDd -> + DDDDDDDDDDDDDDDDdD + +let _ = + match a with + | AAAAAAAAAA -> ( + let x = 3 in + match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> + bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> + ccccccccccccccccc ) + | DDDDDDDDDDDDDDd -> + DDDDDDDDDDDDDDDDdD + +let _ = + match x with + | _ -> ( + match + something long enough to_break + _________________________________________________________________ + with + | AAAAAAAAAA -> ( + let x = 3 in + match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> + bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> + ccccccccccccccccc ) + | DDDDDDDDDDDDDDd -> + DDDDDDDDDDDDDDDDdD ) + +let x = + let g = + match x with + | `A -> ( + fun id -> function A -> e ; e | _ -> () ) + | `B -> ( + fun id -> function A -> e ; e | _ -> () ) + in + () + +let x = + let g = + match x with + | `A -> ( + fun id -> function A -> () | B -> () ) + | `B -> ( + fun id -> function A -> () | _ -> () ) + in + () + +let x = + let g = + match x with + | `A -> ( + function A -> () | B -> () ) + | `B -> ( + function A -> () | _ -> () ) + in + () + +let x = + let g = match x with `A -> fun (A | B) -> () | `B -> fun (A | _) -> () in + () + +let _ = match x with _ -> b >>= fun () -> c diff --git a/test/passing/refs.ocamlformat/match2.ml.ref b/test/passing/refs.ocamlformat/match2.ml.ref new file mode 100644 index 0000000000..77152ca210 --- /dev/null +++ b/test/passing/refs.ocamlformat/match2.ml.ref @@ -0,0 +1,111 @@ +let _ = match a with A -> (match b with B -> b | C -> c) | D -> D + +let _ = + match a with + | AAAAAAAAAA -> + ( match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> + bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> + ccccccccccccccccc ) + | DDDDDDDDDDDDDDd -> + DDDDDDDDDDDDDDDDdD + +let _ = + match a with + | AAAAAAAAAA -> + let x = 3 in + ( match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> + bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> + ccccccccccccccccc ) + | DDDDDDDDDDDDDDd -> + DDDDDDDDDDDDDDDDdD + +let _ = + match x with + | _ -> + ( match + something long enough to_break + _________________________________________________________________ + with + | AAAAAAAAAA -> + let x = 3 in + ( match bbbbbbbbbbbbb with + | BBbbbbbbbbbbbbb -> + bbbbbbbbbbbb + | CCCCCCCCCCCCCCcc -> + ccccccccccccccccc ) + | DDDDDDDDDDDDDDd -> + DDDDDDDDDDDDDDDDdD ) + +let x = + let g = + match x with + | `A -> + fun id -> (function A -> () | B -> ()) + | `B -> + fun id -> (function A -> () | _ -> ()) + in + () + +let x = + let g = + match x with + | `A -> + (function A -> () | B -> ()) + | `B -> + (function A -> () | _ -> ()) + in + () + +let x = + let g = match x with `A -> fun (A | B) -> () | `B -> fun (A | _) -> () in + () + +let _ = match x with _ -> b >>= fun () -> c + +[@@@ocamlformat "break-infix-before-func=false"] + +let foo = match foo with 1 -> bar >>= ( function _ -> () ) | other -> () + +let foo = + match foo with + | 1 -> + bar >>= ( function a -> fooooo | b -> fooooo | _ -> () ) + | other -> + () + +let foo = + match foo with + | 1 -> + bar >>= ( function + | a -> + fooooo + | b -> + fooooo + | c -> + foooooooo foooooooooo fooooooooooooooooooo () + | _ -> + () ) + | other -> + () + +let _ = + match a with + | a -> + ( match a with + | a -> + let+ a = b in + (match a with a -> a) ) + +let _ = + match a with + | a -> + ( match a with + | a -> + let+ a = b in + (match a with a -> a) + | b -> + c ) diff --git a/test/passing/refs.ocamlformat/match_indent-never.ml.ref b/test/passing/refs.ocamlformat/match_indent-never.ml.ref new file mode 100644 index 0000000000..679eaac511 --- /dev/null +++ b/test/passing/refs.ocamlformat/match_indent-never.ml.ref @@ -0,0 +1,24 @@ +match fooooooooooooooooooooooo with + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + +let foooooooo = + match fooooooooooooooooooooooo with + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + +let foooooooo = + try fooooooooooooooooooooooo with + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + +let fooooo = + if foooooooo then + match fooooooooooooooooooooooo with + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + else foooooooo diff --git a/test/passing/refs.ocamlformat/match_indent.ml.ref b/test/passing/refs.ocamlformat/match_indent.ml.ref new file mode 100644 index 0000000000..dab794aa7b --- /dev/null +++ b/test/passing/refs.ocamlformat/match_indent.ml.ref @@ -0,0 +1,24 @@ +match fooooooooooooooooooooooo with + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + +let foooooooo = + match fooooooooooooooooooooooo with + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + +let foooooooo = + try fooooooooooooooooooooooo with + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + +let fooooo = + if foooooooo then + match fooooooooooooooooooooooo with + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + | fooooooooooooooooooooooo -> + foooooooooooooooooooooooooo + else foooooooo diff --git a/test/passing/refs.ocamlformat/max_indent.ml.ref b/test/passing/refs.ocamlformat/max_indent.ml.ref new file mode 100644 index 0000000000..72a1c3731d --- /dev/null +++ b/test/passing/refs.ocamlformat/max_indent.ml.ref @@ -0,0 +1,92 @@ +let () = + fooooo + |> List.iter (fun x -> + let x = x $ y in + fooooooooooo x ) + +let () = + fooooo + |> List.iter + (fun some_really_really_really_long_name_that_doesn't_fit_on_the_line -> + let x = + some_really_really_really_long_name_that_doesn't_fit_on_the_line $ y + in + fooooooooooo x ) + +let foooooooooo = + foooooooooooooooooooooo + |> Option.bind ~f:(function + | Pform.Expansion.Var (Values l) -> + Some (static l) + | Macro (Ocaml_config, s) -> + Some (static (expand_ocaml_config (Lazy.force ocaml_config) var s)) + | Macro (Env, s) -> + Option.map ~f:static (expand_env t var s) ) + +let fooooooooooooo = + match lbls with + | (_, {lbl_all}, _) :: _ -> + let t = + Array.map + (fun lbl -> (mknoloc (Longident.Lident "?temp?"), lbl, omega)) + lbl_all + in + fooooooo + +let foooooooooo = + match fooooooooooooo with + | Pexp_construct + ({txt= Lident "::"; _}, Some {pexp_desc= Pexp_tuple [_; e2]; _}) -> + if is_sugared_list e2 then Some (Semi, Non) + else Some (ColonColon, if exp == e2 then Right else Left) + +let foooooooooooooooooooooooooo = + match foooooooooooooooooooooo with + | Pexp_apply + ( { pexp_desc= + Pexp_ident {txt= Lident (("~-" | "~-." | "~+" | "~+.") as op); loc} + ; pexp_loc + ; pexp_attributes= [] + ; _ } + , [(Nolabel, e1)] ) -> + fooooooooooooooooooooooooooooooooooooo + +let fooooooooooooooooooooooooooooooooooo = + match foooooooooooooooooooooo with + | ( Ppat_constraint + (({ppat_desc= Ppat_var _; _} as p0), {ptyp_desc= Ptyp_poly ([], t0); _}) + , Pexp_constraint (e0, t1) ) + when Poly.(t0 = t1) -> + m.value_binding m + +let foooooooooooooooooooooooooooooooo = + match foooooooooooooooooooooooooooo with + | Tpat_variant (lab, Some omega, _) -> ( + fun q rem -> + match q.pat_desc with + | Tpat_variant (lab', Some arg, _) when lab = lab' -> + (p, arg :: rem) + | Tpat_any -> + (p, omega :: rem) + | _ -> + raise NoMatch ) + +let x = + some_fun________________________________ + some_arg______________________________ (fun param -> + do_something () ; do_something_else () ; return_this_value ) + +let x = + some_fun________________________________ + some_arg______________________________ ~f:(fun param -> + do_something () ; do_something_else () ; return_this_value ) + +let x = + some_value + |> some_fun (fun x -> + do_something () ; do_something_else () ; return_this_value ) + +let x = + some_value + ^ some_fun (fun x -> + do_something () ; do_something_else () ; return_this_value ) diff --git a/test/passing/refs.ocamlformat/mod_type_subst.ml.ref b/test/passing/refs.ocamlformat/mod_type_subst.ml.ref new file mode 100644 index 0000000000..6c548683fe --- /dev/null +++ b/test/passing/refs.ocamlformat/mod_type_subst.ml.ref @@ -0,0 +1,184 @@ +(** Basic *) +module type x = sig + type t = int +end + +module type t = sig + module type x + + module M : x +end + +module type t' = t with module type x = x + +module type t'' = t with module type x := x + +module type t3 = + t + with + module type x = sig + type t + end + +module type t4 = + t + with + module type x := sig + type t + end + +(** nested *) + +module type ENDO = sig + module Inner : sig + module type T + + module F (_ : T) : T + end +end + +module type ENDO_2 = ENDO with module type Inner.T = ENDO + +module type ENDO_2' = ENDO with module type Inner.T := ENDO + +module type S = sig + module M : sig + module type T + end + + module N : M.T +end + +module type R = S with module type M.T := sig end + +(** Adding equalities *) + +module type base = sig + type t = X of int | Y of float +end + +module type u = sig + module type t = sig + type t = X of int | Y of float + end + + module M : t +end + +module type s = u with module type t := base + +module type base = sig + type t = X of int | Y of float +end + +module type u = sig + type x + + type y + + module type t = sig + type t = X of x | Y of y + end + + module M : t +end + +module type r = u with type x = int and type y = float and module type t = base + +module type r = u with type x = int and type y = float and module type t := base + +(** First class module types require an identity *) + +module type fst = sig + module type t + + val x : (module t) +end + +module type ext + +module type fst_ext = fst with module type t = ext + +module type fst_ext = fst with module type t := ext + +module type fst_erased = fst with module type t := sig end + +module type fst_ok = fst with module type t = sig end + +module type S = sig + module M : sig + module type T + end + + val x : (module M.T) +end + +module type R = S with module type M.T := sig end + +module type S = sig + module M : sig + module type T + + val x : (module T) + end +end + +module type R = S with module type M.T := sig end + +(** local module type substitutions *) + +module type s = sig + module type u := sig + type a + + type b + + type c + end + + module type r = sig + type r + + include u + end + + module type s = sig + include u + + type a = A + end +end + +module type s = sig + module type u := sig + type a + + type b + + type c + end + + module type wrong = sig + type a + + include u + end +end + +module type fst = sig + module type t := sig end + + val x : (module t) +end + +module type hidden = sig + module type t := sig + type u + end + + include t + + val x : (module t) + + val x : int +end diff --git a/test/passing/refs.ocamlformat/module.ml.ref b/test/passing/refs.ocamlformat/module.ml.ref new file mode 100644 index 0000000000..b55f2f7f8c --- /dev/null +++ b/test/passing/refs.ocamlformat/module.ml.ref @@ -0,0 +1,123 @@ +module AAAAAAAAAAAAAAAAAAA = + Soooooooooooooooooooooooome.Loooooooooooooooooooooooong.Mod + +let _ = + let module A = B in + let module AAAAAAAAAAAAAAAAAAA = + Soooooooooooooooooooooooome.Loooooooooooooooooooooooong.Mod + in + t + +let create (type a b) t i w p = + let module T = (val (t : (a, b) t)) in + T.create i w p + +module C = struct + module rec A : sig + type t + + module rec B : sig + type t + + type z + end + + and A : B + end = + A + + and B : sig end = B +end + +module O : sig + type t +end +with type t := t = struct + let () = () +end + +module O : sig + type t +end +with type t := t + and type s := s = struct + let () = () +end + +include struct + (* a *) +end + +include A (struct + (* a *) +end) + +let x : (module S) = (module struct end) + +let x = (module struct end : S) + +module rec A : (sig + type t +end +with type t = int) = struct + type t = int +end + +module A (_ : S) = struct end + +module A : functor (_ : S) -> S' = functor (_ : S) -> struct end + +let helper ?x = + match x with Some (module X : X_typ) -> X.f | None -> X_add_one.f + +let helper ?x:((module X) = (module X_add_one : X_typ)) = X.f + +module GZ : functor (X : sig end) () (Z : sig end) -> sig end = + (val Mooooooooooooooooooo) + +module GZZZZZZZZZZZZZZ : functor (X : sig end) () (Z : sig end) -> sig end = _ + +module M = struct end + +module M = F () +module M = F (* xxx *) ( (* xxx *) ) (* xxx *) + +module M = F (struct end) + +module M = F (G) () +module M = F (G) ( (* xxx *) ) + +module M = F (G) (struct end) + +module M = + F + (struct + val x : t + + val y : t + end) + ( (* struct type z = K.y end *) ) + +let _ = + let module M = + (val (* aa *) m (* bb *) : (* cc *) M (* dd *) :> (* ee *) N (* ff *)) + in + let module M = + ( val m + : M with type t = k and type p = k + :> N with type t = t and type k = t ) + in + let module M = + ( val (* aa *) m (* bb *) + : (* cc *) + M with type t = t (* dd *) + :> (* ee *) + N with type t = t (* ff *) ) + in + () + +module M = + [%demo + module Foo = Bar + + type t] diff --git a/test/passing/refs.ocamlformat/module_anonymous.ml.ref b/test/passing/refs.ocamlformat/module_anonymous.ml.ref new file mode 100644 index 0000000000..04d8a138a1 --- /dev/null +++ b/test/passing/refs.ocamlformat/module_anonymous.ml.ref @@ -0,0 +1,30 @@ +module _ = struct + let x = (13, 37) +end + +module rec A : sig + type t = B.t +end = + A + +and _ : sig + type t = A.t + + val x : int * int +end = struct + type t = B.t + + let x = (4, 2) +end + +and B : sig + type t +end = struct + type t + + let x = ("foo", "bar") +end + +module type S + +let f (module _ : S) = () diff --git a/test/passing/tests/module_attributes.ml.ref b/test/passing/refs.ocamlformat/module_attributes.ml.ref similarity index 100% rename from test/passing/tests/module_attributes.ml.ref rename to test/passing/refs.ocamlformat/module_attributes.ml.ref diff --git a/test/passing/tests/module_item_spacing-preserve.ml.ref b/test/passing/refs.ocamlformat/module_item_spacing-preserve.ml.ref similarity index 95% rename from test/passing/tests/module_item_spacing-preserve.ml.ref rename to test/passing/refs.ocamlformat/module_item_spacing-preserve.ml.ref index cf596b6ac4..c940bf8b13 100644 --- a/test/passing/tests/module_item_spacing-preserve.ml.ref +++ b/test/passing/refs.ocamlformat/module_item_spacing-preserve.ml.ref @@ -7,10 +7,10 @@ let z = so is this oooooooooooooooooooooooooooooooooooooooooooone let g = () let f = function - | `a | `b | `c -> foo + | `a | `b | `c -> + foo | `xxxxxxxxxxxxxxxxxx -> - yyyyyyyyyyyyyyyyyyyyyyyy - zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + yyyyyyyyyyyyyyyyyyyyyyyy zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz diff --git a/test/passing/tests/module_item_spacing-sparse.ml.ref b/test/passing/refs.ocamlformat/module_item_spacing-sparse.ml.ref similarity index 95% rename from test/passing/tests/module_item_spacing-sparse.ml.ref rename to test/passing/refs.ocamlformat/module_item_spacing-sparse.ml.ref index 171ec9880f..bc51061109 100644 --- a/test/passing/tests/module_item_spacing-sparse.ml.ref +++ b/test/passing/refs.ocamlformat/module_item_spacing-sparse.ml.ref @@ -11,10 +11,10 @@ let z = so is this oooooooooooooooooooooooooooooooooooooooooooone let g = () let f = function - | `a | `b | `c -> foo + | `a | `b | `c -> + foo | `xxxxxxxxxxxxxxxxxx -> - yyyyyyyyyyyyyyyyyyyyyyyy - zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + yyyyyyyyyyyyyyyyyyyyyyyy zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz diff --git a/test/passing/tests/module_item_spacing.ml.ref b/test/passing/refs.ocamlformat/module_item_spacing.ml.ref similarity index 95% rename from test/passing/tests/module_item_spacing.ml.ref rename to test/passing/refs.ocamlformat/module_item_spacing.ml.ref index f411858223..293957d855 100644 --- a/test/passing/tests/module_item_spacing.ml.ref +++ b/test/passing/refs.ocamlformat/module_item_spacing.ml.ref @@ -7,10 +7,10 @@ let z = so is this oooooooooooooooooooooooooooooooooooooooooooone let g = () let f = function - | `a | `b | `c -> foo + | `a | `b | `c -> + foo | `xxxxxxxxxxxxxxxxxx -> - yyyyyyyyyyyyyyyyyyyyyyyy - zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + yyyyyyyyyyyyyyyyyyyyyyyy zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz diff --git a/test/passing/tests/module_item_spacing.mli.ref b/test/passing/refs.ocamlformat/module_item_spacing.mli.ref similarity index 100% rename from test/passing/tests/module_item_spacing.mli.ref rename to test/passing/refs.ocamlformat/module_item_spacing.mli.ref diff --git a/test/passing/refs.ocamlformat/module_type.ml.err b/test/passing/refs.ocamlformat/module_type.ml.err new file mode 100644 index 0000000000..8d344e8fe3 --- /dev/null +++ b/test/passing/refs.ocamlformat/module_type.ml.err @@ -0,0 +1,2 @@ +Warning: module_type.ml:38 exceeds the margin +Warning: module_type.ml:75 exceeds the margin diff --git a/test/passing/refs.ocamlformat/module_type.ml.ref b/test/passing/refs.ocamlformat/module_type.ml.ref new file mode 100644 index 0000000000..52e2aa0ffb --- /dev/null +++ b/test/passing/refs.ocamlformat/module_type.ml.ref @@ -0,0 +1,113 @@ +module type S = sig + val x : unit -> unit +end + +let get = failwith "TODO" + +let foo () = + let module X = (val get : S) in + X.x () + +module type S = sig end + +type t = (module S) + +type 'a monoid_a = (module Monoid with type t = 'a) + +type 'a monoid_a = (module Monoid with type F.t = 'a) + +let sumi (type a) ((module A) : a monoid_a) (n : a) = A.mappend n A.mempty + +module type BAR = sig + module rec A : (FOO with type t = < b: B.t >) + + and B : FOO +end + +module type M = + module type of M + with module A := A + (*test*) + and module A = A + (*test*) + and module A = A + with module A = A + (*test*) + with module A = A + +module U : + S with type ttttttttt = int and type uuuuuuuu = int and type vvvvvvvvvvv = int = +struct end + +module U : + S with type ttttttttt = int and type uuuuuuu = int with type vvvvvvvvv = int = +struct end + +module U : + S + with type Command.t = + [ `Halt + | `Unknown + | `Error of string + | `Config of (string * string) list + | `Format of string ] + and type Command.t = + [ `Halt + | `Unknown + | `Error of string + | `Config of (string * string) list + | `Format of string ] = struct end + +module U = (val S : S with type t = int and type u = int) + +module U = (val S : S with type t = int and type u = int) + +module type S = sig + (* floating *) + + exception E +end + +module type S' = functor + (A : A) + (B : sig + type t + end) + (Cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc : sig + type t + end) + -> S with type t = B.t + +module M : sig + include (* foo *) module type of K + + include module type of + Fooooooooooooooooooooooooooo (Foooooooooo.Foo) (Fooooooooooooo) + (Fooooooooooooo) + + include (* fooooooooo *) module type of + Fooooooooooooooooooooooooooo (Foooooooooo.Foo) (Fooooooooooooo) + (Fooooooooooooo) +end = struct end + +let foo (type foooo fooo_ooooo) + (module Fooo : Fooooo_foooooooooo.Foooo_intf.Bar + with type foooo = foooo + and type Fooo_fooooooooo_fooooo.t = + ( xxxxx + , wwwwwwwwww + , xxxxxxxxxxxxxxxxxxxx + , xxxxxxxxxxxxxxxxx + , xxxxxxxxxxxxxxxxxxxxxx + , yyyyyyyyyyyyyyyyyyyyyy ) + Fooooo_ooooooo_oooooo.Foooo_fooooooooo_fooooo.t ) + (Fooo.Fooo.T (foo, bar)) xxxx = + () + +module N : S with module type T = (U with module M = M) = struct end + +module type Grammar = functor + (Nonterm : Nonterminal) + (* Set of nonterminals *) + (Attr : Attribute) + -> sig end diff --git a/test/passing/refs.ocamlformat/module_type.mli.err b/test/passing/refs.ocamlformat/module_type.mli.err new file mode 100644 index 0000000000..2c5587aad9 --- /dev/null +++ b/test/passing/refs.ocamlformat/module_type.mli.err @@ -0,0 +1 @@ +Warning: module_type.mli:3 exceeds the margin diff --git a/test/passing/refs.ocamlformat/module_type.mli.ref b/test/passing/refs.ocamlformat/module_type.mli.ref new file mode 100644 index 0000000000..30cf318687 --- /dev/null +++ b/test/passing/refs.ocamlformat/module_type.mli.ref @@ -0,0 +1,4 @@ +(* Wrapping an empty sig *) +module Foo + (A : FOO) + (B : FOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO) : sig end diff --git a/test/passing/refs.ocamlformat/monadic_binding.ml.ref b/test/passing/refs.ocamlformat/monadic_binding.ml.ref new file mode 100644 index 0000000000..a3a1f64ec4 --- /dev/null +++ b/test/passing/refs.ocamlformat/monadic_binding.ml.ref @@ -0,0 +1,37 @@ +let ( let* ) t f = fooooooo + +let ( and* ) t1 t2 = foooooo + +let map f t = + let* a = t in + pure (f a) + +let ( and+ ) t1 t2 = ( and* ) t1 t2 + +let ( and+ ) t1 t2 = ( and* ) t1 t2 x + +let ( and+ ) t1 t2 = + ( and* ) t1 t2 x foooooooooooooooooo foooooooooooooooooooo foooooooooooooooooo + foooooooooooooooooo + +let _ = ( let* ) x (fun y -> z) + +let _ = ( let* ) x (function y -> z) + +let _ = f (( let* ) x (fun y -> z)) + +let _ = f (( let* ) x (function y -> z)) + +let _ = ( let+ ) [@attr] + +let _ = f (( let+ ) [@attr]) ;; + +( let+ ) [@attr] + +let _ = + let* (args, _) : bar = () in + let* (arg : bar) = () in + let* (_ : foo) = () in + let* (_ as t) = xxx in + let+ (Ok x) = xxx in + () diff --git a/test/passing/refs.ocamlformat/multi_index_op.ml.ref b/test/passing/refs.ocamlformat/multi_index_op.ml.ref new file mode 100644 index 0000000000..48e5889314 --- /dev/null +++ b/test/passing/refs.ocamlformat/multi_index_op.ml.ref @@ -0,0 +1,14 @@ +let ( .%{;..} ) = Genarray.get + +let ( .%{;..}<- ) = Genarray.set + +let () = + let x = Genarray.create Float64 c_layout [|3; 4; 5|] in + x.%{0; 0; 0} <- 3. ; + Printf.printf "%f\n" x.%{0; 0; 0} + +(** With path *) + +let _ = a.A.B.*(b; c) + +let _ = a.A.B.*(b; c) <- d diff --git a/test/passing/refs.ocamlformat/named_existentials.ml.ref b/test/passing/refs.ocamlformat/named_existentials.ml.ref new file mode 100644 index 0000000000..1420d26342 --- /dev/null +++ b/test/passing/refs.ocamlformat/named_existentials.ml.ref @@ -0,0 +1,26 @@ +let ok1 = function Dyn (type a) ((w, x) : a ty * a) -> ignore (x : a) + +let ok2 = function Dyn (type a) ((w, x) : _ * a) -> ignore (x : a) + +type u = C : 'a * ('a -> 'b list) -> u + +let f = function C (type a b) ((x, f) : _ * (a -> b list)) -> ignore (x : a) + +(* with GADT unification *) +type _ expr = + | Int : int -> int expr + | Add : (int -> int -> int) expr + | App : ('a -> 'b) expr * 'a expr -> 'b expr + +let rec eval : type t. t expr -> t = function + | Int n -> + n + | Add -> + ( + ) + | App (type a) ((f, x) : _ * a expr) -> + eval f (eval x : a) + +(* Also allow annotations on multiary constructors *) +type ('a, 'b) pair = Pair of 'a * 'b + +let f = function Pair ((x, y) : int * _) -> x + y diff --git a/test/passing/refs.ocamlformat/need_format.ml.err b/test/passing/refs.ocamlformat/need_format.ml.err new file mode 100644 index 0000000000..5f78142e1f --- /dev/null +++ b/test/passing/refs.ocamlformat/need_format.ml.err @@ -0,0 +1 @@ +ocamlformat: "need_format.ml" was not already formatted. ([max-iters = 1]) diff --git a/test/passing/refs.ocamlformat/new.ml.ref b/test/passing/refs.ocamlformat/new.ml.ref new file mode 100644 index 0000000000..ff29aab24b --- /dev/null +++ b/test/passing/refs.ocamlformat/new.ml.ref @@ -0,0 +1,15 @@ +let x = new Objects.one ~hello:true () + +let _ = sprintf "Date: %s" (Js.to_string (new%js Js.date_now)##toString) + +let _ = f (new test) a b + +let _ = f (new test x) a b + +let _ = f (new test (new test a b) c) a b + +let _ = f (new%js test) a b + +let _ = f (new%js test x) a b + +let _ = f (new%js test (new%js test a b) c) a b diff --git a/test/passing/tests/object.ml.ref b/test/passing/refs.ocamlformat/object.ml.ref similarity index 100% rename from test/passing/tests/object.ml.ref rename to test/passing/refs.ocamlformat/object.ml.ref diff --git a/test/passing/tests/object2.ml.ref b/test/passing/refs.ocamlformat/object2.ml.ref similarity index 100% rename from test/passing/tests/object2.ml.ref rename to test/passing/refs.ocamlformat/object2.ml.ref diff --git a/test/passing/tests/object_expr-414.ml.ref b/test/passing/refs.ocamlformat/object_expr-414.ml.ref similarity index 100% rename from test/passing/tests/object_expr-414.ml.ref rename to test/passing/refs.ocamlformat/object_expr-414.ml.ref diff --git a/test/passing/tests/object_expr.ml.ref b/test/passing/refs.ocamlformat/object_expr.ml.ref similarity index 100% rename from test/passing/tests/object_expr.ml.ref rename to test/passing/refs.ocamlformat/object_expr.ml.ref diff --git a/test/passing/tests/object_type.ml.ref b/test/passing/refs.ocamlformat/object_type.ml.ref similarity index 100% rename from test/passing/tests/object_type.ml.ref rename to test/passing/refs.ocamlformat/object_type.ml.ref diff --git a/test/passing/tests/obuild.ml.ref b/test/passing/refs.ocamlformat/obuild.ml.ref similarity index 100% rename from test/passing/tests/obuild.ml.ref rename to test/passing/refs.ocamlformat/obuild.ml.ref diff --git a/test/passing/tests/ocp_indent_compat-break_colon_after.ml.ref b/test/passing/refs.ocamlformat/ocp_indent_compat-break_colon_after.ml.ref similarity index 96% rename from test/passing/tests/ocp_indent_compat-break_colon_after.ml.ref rename to test/passing/refs.ocamlformat/ocp_indent_compat-break_colon_after.ml.ref index f31a421262..6b89d3f198 100644 --- a/test/passing/tests/ocp_indent_compat-break_colon_after.ml.ref +++ b/test/passing/refs.ocamlformat/ocp_indent_compat-break_colon_after.ml.ref @@ -47,8 +47,8 @@ module type M = sig val f : x:t - (** an extremely long comment about [x] that does not fit on the same - line with [x] *) + (** an extremely long comment about [x] that does not fit on the + same line with [x] *) -> unit val f : @@ -58,8 +58,8 @@ module type M = sig -> foooooooooooooo -> foooooooooooooo * fooooooooooooooooo -> foooooooooooooooo ) - (** an extremely long comment about [x] that does not fit on the same - line with [x] *) + (** an extremely long comment about [x] that does not fit on the + same line with [x] *) -> unit end diff --git a/test/passing/refs.ocamlformat/ocp_indent_compat.ml.ref b/test/passing/refs.ocamlformat/ocp_indent_compat.ml.ref new file mode 100644 index 0000000000..bb5742a26e --- /dev/null +++ b/test/passing/refs.ocamlformat/ocp_indent_compat.ml.ref @@ -0,0 +1,94 @@ +(* Bad: unboxing the function type *) +external i : (int -> float[@unboxed]) = "i" "i_nat" + +module type M = sig + val action : action + (** Formatting action: input type and source, and output destination. *) + + val doc_atrs + : (string Location.loc * payload) list + -> (string Location.loc * bool) list option + * (string Location.loc * payload) list + + val transl_modtype_longident + (* from Typemod *) + : (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val transl_modtype_longident + (* foooooooooo fooooooooooooo foooooooooooo foooooooooooooo + foooooooooooooo foooooooooooo + *) + : (Location.t -> Env.t -> Longident.t -> Path.t) ref + + val imported_sets_of_closures_table + : Simple_value_approx.function_declarations option Set_of_closures_id.Tbl.t + + type 'a option_decl = + names:string list + -> doc:string + -> section:[`Formatting | `Operational] + -> ?allow_inline:bool + -> (config -> 'a -> config) + -> (config -> 'a) + -> 'a t + + val select + : (* The fsevents context *) + env + -> (* Additional file descriptor to select for reading *) + ?read_fdl:fd_select list + -> (* Additional file descriptor to select for writing *) + ?write_fdl:fd_select list + -> (* Timeout...like Unix.select *) + timeout:float + -> (* The callback for file system events *) + (event list -> unit) + -> unit + + val f + : x:t + (** an extremely long comment about [x] that does not fit on the + same line with [x] *) + -> unit + + val f + : fooooooooooooooooo: + (fooooooooooooooo + -> fooooooooooooooooooo + -> foooooooooooooo + -> foooooooooooooo * fooooooooooooooooo + -> foooooooooooooooo ) + (** an extremely long comment about [x] that does not fit on the + same line with [x] *) + -> unit +end + +let ssmap + : (module MapT + with type key = string + and type data = string + and type map = SSMap.map ) + = + () + +let ssmap + : (module MapT + with type key = string + and type data = string + and type map = SSMap.map ) + -> unit + = + () + +let long_function_name + : type a. a long_long_type -> a -> a -> a -> wrap_wrap_wrap -> unit + = + fun () -> () + +let add_edge target dep = + if target <> dep then ( + Hashtbl.replace edges dep + (target :: (try Hashtbl.find edges dep with Not_found -> [])) ; + Hashtbl.replace edge_count target + (1 + try Hashtbl.find edge_count target with Not_found -> 0) ; + if not (Hashtbl.mem edge_count dep) then Hashtbl.add edge_count dep 0 ) diff --git a/test/passing/tests/ocp_indent_options.ml.ref b/test/passing/refs.ocamlformat/ocp_indent_options.ml.ref similarity index 86% rename from test/passing/tests/ocp_indent_options.ml.ref rename to test/passing/refs.ocamlformat/ocp_indent_options.ml.ref index e3e56890a2..c58a9d1a40 100644 --- a/test/passing/tests/ocp_indent_options.ml.ref +++ b/test/passing/refs.ocamlformat/ocp_indent_options.ml.ref @@ -1,7 +1,8 @@ let _ = let f x y = match x with - | None -> false + | None -> + false | Some loooooooooooooooooooooooooooooooooooooooooooooooooooooooooong -> ( match y with Some _ -> true | None -> false ) in diff --git a/test/passing/tests/open-closing-on-separate-line.ml.ref b/test/passing/refs.ocamlformat/open-closing-on-separate-line.ml.ref similarity index 99% rename from test/passing/tests/open-closing-on-separate-line.ml.ref rename to test/passing/refs.ocamlformat/open-closing-on-separate-line.ml.ref index 93fe77f6ba..68bcfd6042 100644 --- a/test/passing/tests/open-closing-on-separate-line.ml.ref +++ b/test/passing/refs.ocamlformat/open-closing-on-separate-line.ml.ref @@ -33,9 +33,7 @@ let _ = let () = ( (let open Term in term_result - (const Phases.phase1 $ arch $ hub_id $ build_dir $ logs_dir - $ setup_logs - ) + (const Phases.phase1 $ arch $ hub_id $ build_dir $ logs_dir $ setup_logs) ) , Term.info "phase1" ~doc ~sdocs:Manpage.s_common_options ~exits ~man ) diff --git a/test/passing/tests/open.ml.ref b/test/passing/refs.ocamlformat/open.ml.ref similarity index 98% rename from test/passing/tests/open.ml.ref rename to test/passing/refs.ocamlformat/open.ml.ref index ae2e66a76f..9686837ecd 100644 --- a/test/passing/tests/open.ml.ref +++ b/test/passing/refs.ocamlformat/open.ml.ref @@ -33,8 +33,8 @@ let _ = let () = ( (let open Term in term_result - ( const Phases.phase1 $ arch $ hub_id $ build_dir $ logs_dir - $ setup_logs ) ) + (const Phases.phase1 $ arch $ hub_id $ build_dir $ logs_dir $ setup_logs) + ) , Term.info "phase1" ~doc ~sdocs:Manpage.s_common_options ~exits ~man ) let () = diff --git a/test/passing/refs.ocamlformat/open_types.ml.ref b/test/passing/refs.ocamlformat/open_types.ml.ref new file mode 100644 index 0000000000..02c0913ee1 --- /dev/null +++ b/test/passing/refs.ocamlformat/open_types.ml.ref @@ -0,0 +1,3 @@ +type t = .. + +type sub_system = t = .. diff --git a/test/passing/refs.ocamlformat/option.ml.err b/test/passing/refs.ocamlformat/option.ml.err new file mode 100644 index 0000000000..9cad5c9da5 --- /dev/null +++ b/test/passing/refs.ocamlformat/option.ml.err @@ -0,0 +1,29 @@ +File "option.ml", line 63, characters 17-28: +63 | [@@@ocamlformat "margin=90"] + ^^^^^^^^^^^ +Warning 47 [attribute-payload]: illegal payload for attribute 'ocamlformat'. +margin not allowed here + +File "option.ml", line 13, characters 3-19: +13 | [@@ocamlformat.typo "if-then-else=keyword-first"] + ^^^^^^^^^^^^^^^^ +Warning 47 [attribute-payload]: illegal payload for attribute 'ocamlformat.typo'. +Invalid format: Unknown suffix "typo" + +File "option.ml", line 21, characters 3-14: +21 | [@@ocamlformat 1, "if-then-else=keyword-first"] + ^^^^^^^^^^^ +Warning 47 [attribute-payload]: illegal payload for attribute 'ocamlformat'. +Invalid format: String expected + +File "option.ml", line 28, characters 3-14: +28 | [@@ocamlformat "if-then-else=bad"] + ^^^^^^^^^^^ +Warning 47 [attribute-payload]: illegal payload for attribute 'ocamlformat'. +For option "if-then-else": invalid value 'bad', expected one of 'compact', 'fit-or-vertical', 'vertical', 'keyword-first' or 'k-r' + +File "option.ml", line 39, characters 14-25: +39 | [@@ocamlformat "if-then-else=bad"] + ^^^^^^^^^^^ +Warning 47 [attribute-payload]: illegal payload for attribute 'ocamlformat'. +For option "if-then-else": invalid value 'bad', expected one of 'compact', 'fit-or-vertical', 'vertical', 'keyword-first' or 'k-r' diff --git a/test/passing/tests/option.ml.ref b/test/passing/refs.ocamlformat/option.ml.ref similarity index 100% rename from test/passing/tests/option.ml.ref rename to test/passing/refs.ocamlformat/option.ml.ref diff --git a/test/passing/tests/override.ml.ref b/test/passing/refs.ocamlformat/override.ml.ref similarity index 100% rename from test/passing/tests/override.ml.ref rename to test/passing/refs.ocamlformat/override.ml.ref diff --git a/test/passing/refs.ocamlformat/parens_tuple_patterns.ml.ref b/test/passing/refs.ocamlformat/parens_tuple_patterns.ml.ref new file mode 100644 index 0000000000..61170e0dce --- /dev/null +++ b/test/passing/refs.ocamlformat/parens_tuple_patterns.ml.ref @@ -0,0 +1,9 @@ +let a, b = (1, 2) + +let[@ocamlformat "parens-tuple-patterns=always"] (a, b) = (1, 2) + +let[@ocamlformat "parens-tuple-patterns=always"] M.(a, b) = () + +let[@ocamlformat "parens-tuple-patterns=multi-line-only"] a, b = (1, 2) + +let[@ocamlformat "parens-tuple-patterns=multi-line-only"] M.(a, b) = () diff --git a/test/passing/refs.ocamlformat/polytypes.ml.ref b/test/passing/refs.ocamlformat/polytypes.ml.ref new file mode 100644 index 0000000000..7afd0d14e3 --- /dev/null +++ b/test/passing/refs.ocamlformat/polytypes.ml.ref @@ -0,0 +1,49 @@ +let t1 : 'a 'b. 'a t -> b t = () + +let t2 : + 'a 'b. + 'a t________________________________ + -> 'b t_______________________________________ = + () + +let t3 : + 'long 'sequence 'of_ 'universally 'quantified 'type_ 'variables 'that 'must + 'wrap. + 'a t_________________________________________________ + -> 'b t______________________________________________________________ + -> 'c t______________________________________________________________ = + () + +let t4 : + 'long 'sequence 'of_ 'universally 'quantified 'type_ 'variables 'that 'must + 'wrap. + 'a t_________________________________________________ + * 'b t______________________________________________________________ + * 'c t______________________________________________________________ = + () + +let foo : type a. a = + (* aaaaaa *) + failwith "foo" + +class c = + let id : 'a. 'a -> 'a = fun x -> x in + object end + +let _ = + let id : 'a. 'a -> 'a = fun x -> x in + () + +let equal_list : + 'a. ('a, 't) gexpr marked list -> ('a, 't) gexpr marked list -> bool = + fun es1 es2 -> + try List.for_all2 equal es1 es2 with Invalid_argument _ -> false + +let rec equal_list : + 'a. ('a, 't) gexpr marked list -> ('a, 't) gexpr marked list -> bool = + fun es1 es2 -> + try List.for_all2 equal es1 es2 with Invalid_argument _ -> false + +and equal : 'a. ('a, 't) gexpr marked -> ('a, 't) gexpr marked -> bool = + fun (type a) (e1 : (a, 't) gexpr marked) (e2 : (a, 't) gexpr marked) -> + match (Marked.unmark e1, Marked.unmark e2) with x -> x diff --git a/test/passing/refs.ocamlformat/pre_post_extensions.ml.ref b/test/passing/refs.ocamlformat/pre_post_extensions.ml.ref new file mode 100644 index 0000000000..ef52df32ba --- /dev/null +++ b/test/passing/refs.ocamlformat/pre_post_extensions.ml.ref @@ -0,0 +1,15 @@ +let f x = + [%Trace.call fun {pf} -> pf "%i" x] + ; + print_int x ; + x + |> + [%Trace.retn fun {pf} -> pf "%i"] + +let f x = + [%Trace.call fun {pf} : t -> pf "%i" x] + ; + print_int x ; + x + |> + [%Trace.retn fun {pf} : t -> pf "%i"] diff --git a/test/passing/refs.ocamlformat/precedence.ml.ref b/test/passing/refs.ocamlformat/precedence.ml.ref new file mode 100644 index 0000000000..727e4b90c6 --- /dev/null +++ b/test/passing/refs.ocamlformat/precedence.ml.ref @@ -0,0 +1,5 @@ +a || (b && c) ;; + +1 + (3 * 5) ;; + +1 < 3 || b diff --git a/test/passing/refs.ocamlformat/prefix_infix.ml.ref b/test/passing/refs.ocamlformat/prefix_infix.ml.ref new file mode 100644 index 0000000000..18f6f1a832 --- /dev/null +++ b/test/passing/refs.ocamlformat/prefix_infix.ml.ref @@ -0,0 +1,27 @@ +let _ = List.filter (( != ) e) l + +let _ = List.map (( != ) x) l + +let _ = x != y + +let _ = - !e + +let _ = - !e.f + +let z = (( ! ) ~x:4) 1 2 ~c:3 + +let z = (( ! ) ~x:4 y z) 1 2 ~c:3 + +let z = (( ! ) ~x:4 [@attr]) 1 2 ~c:3 + +let z = (( ! ) [@attr]) 1 2 ~c:3 + +let z = ( ! ) [@attr] + +let i x = (!r [@attr]) x + +let _ = ( * ) [@attr] + +let _ = f (( * ) [@attr]) ;; + +( * ) [@attr] diff --git a/test/passing/refs.ocamlformat/profiles.ml.ref b/test/passing/refs.ocamlformat/profiles.ml.ref new file mode 100644 index 0000000000..612905711d --- /dev/null +++ b/test/passing/refs.ocamlformat/profiles.ml.ref @@ -0,0 +1,7 @@ +let a = + aaaaaaaaaa + aaaaaaaaa + +let b = + bbbbbbbbbb + bbbbbbbbb diff --git a/test/passing/refs.ocamlformat/profiles2.ml.ref b/test/passing/refs.ocamlformat/profiles2.ml.ref new file mode 100644 index 0000000000..5b8c243632 --- /dev/null +++ b/test/passing/refs.ocamlformat/profiles2.ml.ref @@ -0,0 +1,5 @@ +let a = + aaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaa + +let b = + bbbbbbbbbbbbbbbbbbvvbbb bbbvvvbbbbbbbbbbbbbbbbbbbb bbbbbbbbbbbbbbbbbbbbbb diff --git a/test/passing/refs.ocamlformat/protected_object_types.ml.ref b/test/passing/refs.ocamlformat/protected_object_types.ml.ref new file mode 100644 index 0000000000..4b59720ee5 --- /dev/null +++ b/test/passing/refs.ocamlformat/protected_object_types.ml.ref @@ -0,0 +1,90 @@ +(* Tests of special cases added to avoid emitting [>\] and [>\}], which are + keywords. *) + +(* Regression tests for https://github.com/ocaml-ppx/ocamlformat/issues/1295 + (unnecessary trailing spaces added after object types with attributes). *) + +type t = {foo: (< .. >[@a])} + +type t = {foo: < .. > [@a]} + +type t = A of {foo: (< .. >[@a])} + +type t = A of {foo: < .. > [@a]} + +type t = [`Foo of (< .. >[@a])] + +type t = [`Foo of < .. > [@a]] + +let _ = + object + inherit [b, (< f: unit >[@a])] foo + end + +module Space_around = struct + (* Ensure that the protection mechanism does not add extra spaces when + [--space-around-*] options are sufficient. *) + + module Records = struct + type t = { foo: < .. > } + + type t = A of { foo: < .. > } + end + [@@ocamlformat "space-around-records = true"] + + module Variants = struct + type t = [ `Foo of < .. > ] + end + [@@ocamlformat "space-around-variants"] +end + +module Inside_payloads = struct + (* Regression tests for + https://github.com/ocaml-ppx/ocamlformat/issues/1267 (failure to protect + against object types inside extension and attribute payloads). *) + + let _ = [%ext: < .. > ] + + [%%ext: < .. > ] + + [%%ext + () + + type a = < f: t > ] + + [@@@a: val b : < .. > ] + + let _ = () [@a: val b : < .. > ] + + let _ = () [@@a: val b : < .. > ] + + [@@@a: type x = < .. > ] + + [@@@a: + val x : t + + type x = < .. > ] + + [@@@a: type t = < .. > ] + + [@@@a: type t = (< .. >[@a])] + + [@@@a: type a = A of t | B of t | C of < .. > ] + + [@@@a: type a = A of t | B of t | C of (t -> < .. >)] + + [@@@a: type a += C of a * b * < .. > ] + + [@@@a: type a += C of a * b * < .. > [@a]] + + [@@@a: type a += C of (a -> b * < .. >)] + + [@@@a: type a = t constraint t = < .. > ] + + [@@@a: type a = t constraint t = (< .. >[@a])] + + [@@@a: exception C of a * b * < .. > ] + + (* Simple attributes on exceptions not supported pre-4.08 *) + [@@@a: exception C of a * b * < .. > [@@a]] +end diff --git a/test/passing/refs.ocamlformat/qtest.ml.err b/test/passing/refs.ocamlformat/qtest.ml.err new file mode 100644 index 0000000000..1a25e98fce --- /dev/null +++ b/test/passing/refs.ocamlformat/qtest.ml.err @@ -0,0 +1 @@ +Warning: qtest.ml:21 exceeds the margin diff --git a/test/passing/refs.ocamlformat/qtest.ml.ref b/test/passing/refs.ocamlformat/qtest.ml.ref new file mode 100644 index 0000000000..7515b70aea --- /dev/null +++ b/test/passing/refs.ocamlformat/qtest.ml.ref @@ -0,0 +1,59 @@ +(*$T + false +*) + +(*$T foo + foo 0 ( + ) [1;2;3] = 6 (* hehe *) + foo 0 ( * ) [1;2;3] = 0 (* haha (*hoho *) *) + foo 1 ( * ) [4;5] = 20 + foo 12 ( + ) [] = 12 +*) + +(*$T foo + foo 1 ( * ) [4;5] = foo 2 ( * ) [1;5;2] +*) + +(*$= foo & ~printer:string_of_int + (foo 1 ( * ) [4;5]) (foo 2 ( * ) [1;5;2]) +*) + +(*$Q foo + Q.small_int (fun i-> foo i (+) [1;2;3] = List.fold_left (+) i [1;2;3]) + (Q.pair Q.small_int (Q.list Q.small_int)) (fun (i,l)-> foo i (+) l = List.fold_left (+) i l) +*) + +(*$R foo + let thing = foo 1 ( * ) + and li = [4;5] in + assert_bool "something_witty" (thing li = 20); + (* pertinent comment *) + assert_bool "something_wittier" (1=1) +*) + +(*$inject let brom = baz *) +(*$T brom + brom.[2] = 'z' +*) + +(*$T & + 1 = 2-1 + 2+3 \ + = \ + \ + 5 + + 1+1=2 +*) + +(*$T & 6 \ + & = + 2*3 +*) + +(*$Q & ~count:10 + (Q.small_int_corners ()) (fun n-> n+3 -2 -1 = abs n) +*) + +(*$Q & ~max_gen:1000000 ~count:1000000 + (Q.make (fun _ -> ())) (fun () -> true) +*) diff --git a/test/passing/refs.ocamlformat/quoted_strings.ml.ref b/test/passing/refs.ocamlformat/quoted_strings.ml.ref new file mode 100644 index 0000000000..e5fc64218e --- /dev/null +++ b/test/passing/refs.ocamlformat/quoted_strings.ml.ref @@ -0,0 +1,50 @@ +let foo = {%foo| foooooooooooooo |} + +let foo = (* A *) {%foo| foooooooooooooo |} (* B *) [@attr] (* C *) + +let foo = (* A *) {%foo sep| foooooooooooooo |sep} + +let foo = {%foo| foooooooooooooo |} [@@attr] + +let foo = {%foo| foooooooooooooo |} (* A *) [@@attr] (* B *) + +let foo = {%foo| foooooooooooooo |} [@attr] [@@attr] + +let foo = {%foo| foooooooooooooo |} (* A *) [@attr] (* B *) [@@attr] + +let foo = (* A *) {%foo| foooooooooooooo |} [@attr] (* B *) [@@attr] + +let foo = (* A *) {%foo sep| foooooooooooooo |sep} (* B *) [@@attr] + +{%%foo| foooooooooooooo |} + +{%%foo| foooooooooooooo |} (* A *) [@@attr] (* B *) + +{%%foo sep| foooooooooooooo |sep} + +{%%foo sep| foooooooooooooo |sep} (* A *) [@@attr] + +(* Structures *) +{%%M.foo| <hello>{x} |} + +{%%M.foo bar| <hello>{|x|} |bar} + +(* Signatures *) +module type S = sig + {%%M.foo| <hello>{x} |} + + {%%M.foo bar| <hello>{|x|} |bar} +end + +(* Expressions/Pattern/Types *) +let ({%M.foo| <hello>{x} |} : {%M.foo| <hello>{x} |}) = {%M.foo| <hello>{x} |} + +let ({%M.foo bar| <hello>{|x|} |bar} : {%M.foo bar| <hello>{|x|} |bar}) = + {%M.foo bar| <hello>{|x|} |bar} + +(* Multiline *) +{%%M.foo| + <hello> + {x} + </hello> +|} diff --git a/test/passing/refs.ocamlformat/recmod.mli.ref b/test/passing/refs.ocamlformat/recmod.mli.ref new file mode 100644 index 0000000000..b1beda2c6a --- /dev/null +++ b/test/passing/refs.ocamlformat/recmod.mli.ref @@ -0,0 +1,19 @@ +module rec A : sig + type t = AA of B.t +end + +and B : sig + type t = BB of A.t +end + +include sig + (* a *) +end + +module type S = sig end + +(** A *) +module rec A : S + +(** B *) +and B : S diff --git a/test/passing/refs.ocamlformat/record-402.ml.err b/test/passing/refs.ocamlformat/record-402.ml.err new file mode 100644 index 0000000000..83b3941d50 --- /dev/null +++ b/test/passing/refs.ocamlformat/record-402.ml.err @@ -0,0 +1,2 @@ +Warning: record-402.ml:9 exceeds the margin +Warning: record-402.ml:15 exceeds the margin diff --git a/test/passing/tests/record-402.ml.ref b/test/passing/refs.ocamlformat/record-402.ml.ref similarity index 98% rename from test/passing/tests/record-402.ml.ref rename to test/passing/refs.ocamlformat/record-402.ml.ref index 2819f82bcd..d94b3365d4 100644 --- a/test/passing/tests/record-402.ml.ref +++ b/test/passing/refs.ocamlformat/record-402.ml.ref @@ -62,8 +62,7 @@ type t = let _ = let _ = function | { foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo - ; foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo } - -> + ; foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo } -> () in () diff --git a/test/passing/refs.ocamlformat/record-loose.ml.err b/test/passing/refs.ocamlformat/record-loose.ml.err new file mode 100644 index 0000000000..1866666b58 --- /dev/null +++ b/test/passing/refs.ocamlformat/record-loose.ml.err @@ -0,0 +1,2 @@ +Warning: record-loose.ml:9 exceeds the margin +Warning: record-loose.ml:15 exceeds the margin diff --git a/test/passing/tests/record-loose.ml.ref b/test/passing/refs.ocamlformat/record-loose.ml.ref similarity index 98% rename from test/passing/tests/record-loose.ml.ref rename to test/passing/refs.ocamlformat/record-loose.ml.ref index c1a69a7c46..71ed8f0625 100644 --- a/test/passing/tests/record-loose.ml.ref +++ b/test/passing/refs.ocamlformat/record-loose.ml.ref @@ -62,8 +62,7 @@ type t = let _ = let _ = function | { foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo - ; foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo } - -> + ; foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo } -> () in () diff --git a/test/passing/refs.ocamlformat/record-tight_decl.ml.err b/test/passing/refs.ocamlformat/record-tight_decl.ml.err new file mode 100644 index 0000000000..e89f252ae3 --- /dev/null +++ b/test/passing/refs.ocamlformat/record-tight_decl.ml.err @@ -0,0 +1,2 @@ +Warning: record-tight_decl.ml:9 exceeds the margin +Warning: record-tight_decl.ml:15 exceeds the margin diff --git a/test/passing/tests/record-tight_decl.ml.ref b/test/passing/refs.ocamlformat/record-tight_decl.ml.ref similarity index 98% rename from test/passing/tests/record-tight_decl.ml.ref rename to test/passing/refs.ocamlformat/record-tight_decl.ml.ref index 402048c31d..83dfc6d377 100644 --- a/test/passing/tests/record-tight_decl.ml.ref +++ b/test/passing/refs.ocamlformat/record-tight_decl.ml.ref @@ -62,8 +62,7 @@ type t = let _ = let _ = function | { foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo - ; foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo } - -> + ; foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo } -> () in () diff --git a/test/passing/refs.ocamlformat/record.ml.err b/test/passing/refs.ocamlformat/record.ml.err new file mode 100644 index 0000000000..696299a285 --- /dev/null +++ b/test/passing/refs.ocamlformat/record.ml.err @@ -0,0 +1,2 @@ +Warning: record.ml:9 exceeds the margin +Warning: record.ml:15 exceeds the margin diff --git a/test/passing/tests/record.ml.ref b/test/passing/refs.ocamlformat/record.ml.ref similarity index 98% rename from test/passing/tests/record.ml.ref rename to test/passing/refs.ocamlformat/record.ml.ref index f44841806c..5499b80047 100644 --- a/test/passing/tests/record.ml.ref +++ b/test/passing/refs.ocamlformat/record.ml.ref @@ -62,8 +62,7 @@ type t = let _ = let _ = function | { foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo - ; foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo } - -> + ; foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo } -> () in () diff --git a/test/passing/tests/record_punning.ml.ref b/test/passing/refs.ocamlformat/record_punning.ml.ref similarity index 100% rename from test/passing/tests/record_punning.ml.ref rename to test/passing/refs.ocamlformat/record_punning.ml.ref diff --git a/test/passing/tests/reformat_string.ml.ref b/test/passing/refs.ocamlformat/reformat_string.ml.ref similarity index 100% rename from test/passing/tests/reformat_string.ml.ref rename to test/passing/refs.ocamlformat/reformat_string.ml.ref diff --git a/test/passing/refs.ocamlformat/refs.ml.err b/test/passing/refs.ocamlformat/refs.ml.err new file mode 100644 index 0000000000..22e404a3e3 --- /dev/null +++ b/test/passing/refs.ocamlformat/refs.ml.err @@ -0,0 +1,2 @@ +Warning: refs.ml:2 exceeds the margin +Warning: refs.ml:4 exceeds the margin diff --git a/test/passing/refs.ocamlformat/refs.ml.ref b/test/passing/refs.ocamlformat/refs.ml.ref new file mode 100644 index 0000000000..96c41effc2 --- /dev/null +++ b/test/passing/refs.ocamlformat/refs.ml.ref @@ -0,0 +1,20 @@ +let _ = + x := 2 ; + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx := + 2 ; + xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx := + something very + looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong ; + xxxxxxxxxxxxx xxxxxxxxxxx xxxxxxxxxxxx xxxxxxxxx xxxxxxxxxxxxx xxxxxxxxxx + xxxxxxxxxxxxx + := something very + looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong ; + xx := + something very loooooooooooooooooooooooooooooooooooooooooooooooooooooooong ; + if something loooooooooooong then + xx := + something very loooooooooooooooooooooooooooooooooooooooooooooooooooooooong +;; + +if row <> row' && col <> col' then + b.(row').(col') <- remove b.(row').(col') value diff --git a/test/passing/tests/remove_extra_parens.ml.ref b/test/passing/refs.ocamlformat/remove_extra_parens.ml.ref similarity index 100% rename from test/passing/tests/remove_extra_parens.ml.ref rename to test/passing/refs.ocamlformat/remove_extra_parens.ml.ref diff --git a/test/passing/tests/repl.ml.ref b/test/passing/refs.ocamlformat/repl.ml.ref similarity index 100% rename from test/passing/tests/repl.ml.ref rename to test/passing/refs.ocamlformat/repl.ml.ref diff --git a/test/passing/refs.ocamlformat/repl.mli.ref b/test/passing/refs.ocamlformat/repl.mli.ref new file mode 100644 index 0000000000..967a38e238 --- /dev/null +++ b/test/passing/refs.ocamlformat/repl.mli.ref @@ -0,0 +1,99 @@ +(** VALID BLOCKS: + + Block delimiters should be on their own line: + {[ let x = 1 ]} + + As of odoc 2.1, a block can carry metadata: + {@ocaml[ + let x = 2 + ]} + + An OCaml block that should break: + {[ + let x = 2 in x + x + ]} + + A toplevel phrase with no output: + {[ + # let x = 2 and y = 3 in x+y;; + ]} + + A toplevel phrase with output: + {@ocaml[ + # let x = 2;; + val x : int = 2 + ]} + + Many toplevel phrases without output: + {[ + # let x = 2;; + # x + 2;; + # let x = 2 and y = 3 in x+y;; + ]} + + Many toplevel phrases with output: + {[ + # let x = 2;; + val x : int = 2 + # x + 2;; + - : int = 4 + # let x = 2 and y = 3 in x+y;; + ]} + + Output are printed after a newline: + {[ + # let x = 2;; val x : int = 2 + # let x = 3;; + # let x = 4;; val x : int = 4 + ]} + + Excessive linebreaks are removed: + {[ + + # let x = 2 in x+1;; + + output + + # let y = 3 in y+1;; + + ]} + + Linebreak after `#`: + {[ + # + let x = 2 in x+1;; + ]} +*) +type t = k + +(** INVALID BLOCKS: The formatting of invalid blocks is preserved. + + Invalid toplevel phrase/ocaml block: + {[ + - : int = + 4 + ]} + + Output before a toplevel phrase: + {[ + - : int = 4 + # 2+2;; + ]} + + No `;;` at the end of the phrase, no output: + {[ + # let x = 2 in x+1 + ]} + + No `;;` at the end of the phrase, with output: + {[ + # let x = 2 in x+1 + some output + ]} + + Multiple phrases without `;;` at the end: + {[ + # let x = 2 in x+1 + # let x = 4 in x+1 + ]} +*) diff --git a/test/passing/refs.ocamlformat/revapply_ext.ml.ref b/test/passing/refs.ocamlformat/revapply_ext.ml.ref new file mode 100644 index 0000000000..84ad583dbb --- /dev/null +++ b/test/passing/refs.ocamlformat/revapply_ext.ml.ref @@ -0,0 +1,9 @@ +let _ = + () + (* one *) + |> + [%ext fun _ -> ()] + +let _ = () + |> + [%ext fun _ -> ()] diff --git a/test/passing/refs.ocamlformat/send.ml.ref b/test/passing/refs.ocamlformat/send.ml.ref new file mode 100644 index 0000000000..57084d3da9 --- /dev/null +++ b/test/passing/refs.ocamlformat/send.ml.ref @@ -0,0 +1,11 @@ +let x obj = obj#hello () + +let x obj_f = (obj_f ())#hello () + +let f obj = obj#hello_some_pretty_long_one ~with_labels:true () + +let f obj = + obj#hello_some_pretty_long_one ~with_labels:true "desjd\ndijsde\n" + {md| +In **markdown** +|md} diff --git a/test/passing/tests/sequence-preserve.ml.ref b/test/passing/refs.ocamlformat/sequence-preserve.ml.ref similarity index 100% rename from test/passing/tests/sequence-preserve.ml.ref rename to test/passing/refs.ocamlformat/sequence-preserve.ml.ref diff --git a/test/passing/tests/sequence.ml.ref b/test/passing/refs.ocamlformat/sequence.ml.ref similarity index 100% rename from test/passing/tests/sequence.ml.ref rename to test/passing/refs.ocamlformat/sequence.ml.ref diff --git a/test/passing/refs.ocamlformat/shebang.ml.ref b/test/passing/refs.ocamlformat/shebang.ml.ref new file mode 100644 index 0000000000..64778cc2e9 --- /dev/null +++ b/test/passing/refs.ocamlformat/shebang.ml.ref @@ -0,0 +1,5 @@ +#!/usr/bin/env ocaml + +type t = {a: a; b: b} + +let f x = x diff --git a/test/passing/refs.ocamlformat/shortcut_ext_attr.ml.ref b/test/passing/refs.ocamlformat/shortcut_ext_attr.ml.ref new file mode 100644 index 0000000000..3bb8fa9e45 --- /dev/null +++ b/test/passing/refs.ocamlformat/shortcut_ext_attr.ml.ref @@ -0,0 +1,152 @@ +(* Expressions *) +let () = + let%foo[@foo] x = 3 and[@foo] y = 4 in + [%foo + (let module M = M in + () ) + [@foo]] ; + [%foo M.(()) [@foo]] ; + [%foo fun [@foo] x -> ()] ; + [%foo function[@foo] x -> ()] ; + [%foo try[@foo] () with _ -> ()] ; + [%foo if [@foo] () then () else ()] ; + [%foo + while () do + () + done + [@foo]] ; + [%foo + for x = () to () do + () + done + [@foo]] ; + () ;%foo + () ; + [%foo assert true [@foo]] ; + [%foo lazy x [@foo]] ; + [%foo object end [@foo]] ; + [%foo (3 [@foo])] ; + [%foo new x [@foo]] ; + [%foo + match[@foo] () with + | [%foo? + (* Pattern expressions *) + ((lazy x) [@foo])] -> + () + | [%foo? ((exception x) [@foo])] -> + ()] + +(* Class expressions *) +class x = + fun [@foo] x -> + let[@foo] x = 33 in + object + inherit x [@@foo] + + val x = 333 [@@foo] + + val virtual x : t [@@foo] + + val! mutable x = 3 [@@foo] + + method x = 3 [@@foo] + + method virtual x : t [@@foo] + + method! private x = 3 [@@foo] + + initializer x [@@foo] + end + [@foo] + +(* Class type expressions *) +class type t = object + inherit t [@@foo] + + val x : t [@@foo] + + val mutable x : t [@@foo] + + method x : t [@@foo] + + method private x : t [@@foo] + + constraint t = t' [@@foo] +end[@foo] + +(* Type expressions *) +type t = [%foo: ((module M)[@foo])] + +(* Module expressions *) +module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo])) + +(* Module type expression *) +module type S = functor [@foo1] + (M : S) + -> functor + (_ : (module type of M) [@foo2]) + -> sig end [@foo3] + +(* Structure items *) +let%foo[@foo] x = 4 + +and[@foo] y = x + +type%foo t = int [@@foo] + +and t = int [@@foo] + +type%foo t += T [@@foo] + +class%foo x = x [@@foo] + +class type%foo x = x [@@foo] + +external%foo x : _ = "" [@@foo] + +exception%foo X [@@foo] + +module%foo M = M [@@foo] + +module%foo rec M : S = M [@@foo] + +and M : S = M [@@foo] + +module type%foo S = S [@@foo] + +include%foo M [@@foo] +open%foo M [@@foo] + +(* Signature items *) +module type S = sig + [%%foo: val x : t [@@foo]] + + [%%foo: external x : t = "" [@@foo]] + + type%foo t = int [@@foo] + + and t' = int [@@foo] + + [%%foo: type t += T [@@foo]] + + [%%foo: exception X [@@foo]] + + [%%foo: module [@foo] M : S] + + [%%foo: + module [@foo] rec M : S + + and [@foo] M : S] + + [%%foo: module [@foo] M = M] + + [%%foo: module type S = S [@@foo]] + + [%%foo: include M [@@foo]] + + [%%foo: open M [@@foo]] + + [%%foo: class x : t [@@foo]] + + [%%foo: class type x = x [@@foo]] +end diff --git a/test/passing/refs.ocamlformat/sig_value.mli.err b/test/passing/refs.ocamlformat/sig_value.mli.err new file mode 100644 index 0000000000..f063f1c347 --- /dev/null +++ b/test/passing/refs.ocamlformat/sig_value.mli.err @@ -0,0 +1,2 @@ +Warning: sig_value.mli:4 exceeds the margin +Warning: sig_value.mli:15 exceeds the margin diff --git a/test/passing/tests/sig_value.mli.ref b/test/passing/refs.ocamlformat/sig_value.mli.ref similarity index 83% rename from test/passing/tests/sig_value.mli.ref rename to test/passing/refs.ocamlformat/sig_value.mli.ref index 6b4b6cbe0f..4228f94471 100644 --- a/test/passing/tests/sig_value.mli.ref +++ b/test/passing/refs.ocamlformat/sig_value.mli.ref @@ -2,8 +2,7 @@ val f : f:(string[@att]) (** doc *) -> unit val f : f:(string[@att]) - (** doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc - doc doc doc doc doc doc doc *) + (** doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc *) -> unit val f : f:(string[@att]) -> unit @@ -14,8 +13,7 @@ val f : f:(string * string[@att]) (** doc *) -> unit val f : f:(string * string[@att]) - (** doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc - doc doc doc doc doc doc doc *) + (** doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc doc *) -> unit val f : f:(string * string[@att]) -> unit diff --git a/test/passing/refs.ocamlformat/single_line.mli.ref b/test/passing/refs.ocamlformat/single_line.mli.ref new file mode 100644 index 0000000000..a2c3b20a51 --- /dev/null +++ b/test/passing/refs.ocamlformat/single_line.mli.ref @@ -0,0 +1,6 @@ +[@@@ocamlformat "module-item-spacing=compact"] + +val xx_xxxxxxxx : t -> bool +val xx_xxxxxxxx : t -> bool +val xxxxxxxx : t -> [> `Xxxxxxx | `Xxxxxxxxxxx | `Xxxxxxxxxx | `Xxxxxxxxxxxxx] +val xxxxx : t -> t -> t Xxx.t option diff --git a/test/passing/refs.ocamlformat/skip.ml.ref b/test/passing/refs.ocamlformat/skip.ml.ref new file mode 100644 index 0000000000..e1994e84e3 --- /dev/null +++ b/test/passing/refs.ocamlformat/skip.ml.ref @@ -0,0 +1,125 @@ +[@@@ocamlformat "disable"] + +let this_won't_be_formatted = + 1 +[@@@ocamlformat "enable"] + +let x = function + | A , B -> 1 + | BBB , _ -> 2 + | CCCcccc , CCCCCCCC -> 3 +[@@ocamlformat "disable"] + +let x = function A, B -> 1 | BBB, _ -> 2 | CCCcccc, CCCCCCCC -> 3 + +module S = struct + let x = function + | A , B -> 1 + | BBB , _ -> 2 + | CCCcccc , CCCCCCCC -> (* cmt about 3 *) 3 + [@@ocamlformat "disable"] +end + +module S = struct + let x = function + | A, B -> + 1 + | BBB, _ -> + 2 + | CCCcccc, CCCCCCCC -> + (* cmt about 3 *) 3 + + let x = function + | A, B -> + 1 + | BBB, _ -> + 2 + | CCCcccc, CCCCCCCC -> + (* cmt about 3 *) 3 + + [@@@ocamlformat "disable"] + + let x = function + | A , B -> 1 + | BBB , _ -> 2 + | CCCcccc , CCCCCCCC -> (* cmt about 3 *) 3 + + [@@@ocamlformat "enable"] + + let x = function + | A, B -> + 1 + | BBB, _ -> + 2 + | CCCcccc, CCCCCCCC -> + (* cmt about 3 *) 3 + + let _ = + let x = 3 in + match[@ocamlformat "disable"] x,y with + | Some _, None -> test + | None , Some _ -> test + | Some _, Some _ -> test + | None , None -> test +end + +let x = function + | A, B -> + 1 + | BBB, _ -> + 2 + | CCCcccc, CCCCCCCC -> + (* cmt about 3 *) 3 + +module type S = sig + type t = int * int + [@@ocamlformat "disable"] + + [@@@ocamlformat "disable"] + + val x : a : t -> b: t + -> c : t -> unit +end + +let x = fun fc -> + let x = 3 in + match x,y with + | Some _, None -> test + | None , Some _ -> test + | Some _, Some _ -> test + | None , None -> test + [@@ocamlformat "disable"] + +let x = + fun[@ocamlformat "disable"] fc -> + let x = 3 in + match x,y with + | Some _, None -> test + | None , Some _ -> test + | Some _, Some _ -> test + | None , None -> test + +let _ = (x [@ocamlformat "disable"] [@test? _ when e [@test 2]]) 3 + +let _ = + let module X = struct + let x = 4 + end in + X.x + +let _ = + let module X = + struct + let x = 4 + end [@ocamlformat "disable"] + in + X.x + +let _ = + let module X = struct + module S = + struct + let x = 4 + end [@ocamlformat "disable"] + end in + X.x diff --git a/test/passing/refs.ocamlformat/source.ml.err b/test/passing/refs.ocamlformat/source.ml.err new file mode 100644 index 0000000000..9402afe014 --- /dev/null +++ b/test/passing/refs.ocamlformat/source.ml.err @@ -0,0 +1,5 @@ +Warning: source.ml:1527 exceeds the margin +Warning: source.ml:6474 exceeds the margin +Warning: source.ml:7348 exceeds the margin +Warning: source.ml:7865 exceeds the margin +Warning: source.ml:9599 exceeds the margin diff --git a/test/passing/tests/source.ml.ref b/test/passing/refs.ocamlformat/source.ml.ref similarity index 85% rename from test/passing/tests/source.ml.ref rename to test/passing/refs.ocamlformat/source.ml.ref index 63eb02b32f..9d09b7a251 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/refs.ocamlformat/source.ml.ref @@ -14,9 +14,7 @@ end [@foo] [@@foo] module type S = sig - include - ((module type of M [@foo]) [@foo] with type t := M.t [@foo]) - [@@foo] + include ((module type of M [@foo]) [@foo] with type t := M.t [@foo]) [@@foo] [@@@foo] end [@foo] @@ -25,13 +23,10 @@ end [@foo] [@@@foo] type 'a with_default = - ?size:int (** default [42] *) - -> ?resizable:bool (** default [true] *) - -> 'a + ?size:int (** default [42] *) -> ?resizable:bool (** default [true] *) -> 'a type obj = - < meth1: int -> int (** method 1 *) - ; meth2: unit -> float (** method 2 *) > + < meth1: int -> int (** method 1 *) ; meth2: unit -> float (** method 2 *) > type var = [`Foo (** foo *) | `Bar of int * string (** bar *)] @@ -130,7 +125,8 @@ let () = (* Pattern expressions *) ((lazy x) [@foo])] -> () - | [%foo? ((exception x) [@foo])] -> ()] + | [%foo? ((exception x) [@foo])] -> + ()] (* Class expressions *) class x = @@ -350,7 +346,8 @@ let pop_castable () = | c :: rest -> clist := rest ; c - | [] -> raise Not_found + | [] -> + raise Not_found ;; (* We can add foos and bars to this list, and retrive them *) @@ -480,8 +477,7 @@ module M_S : S = M let is_s x = match x with M_S.A _ -> true | _ -> false -let a2 = - M_S.A 20 (* ERROR: Cannot create a value using a private constructor *) +let a2 = M_S.A 20 (* ERROR: Cannot create a value using a private constructor *) (* Extensions can be rebound *) @@ -755,9 +751,12 @@ let write_string s = Msg.write String s let read_one () = let (Msg.Result (tag, body)) = Msg.read () in match tag with - | Msg.Int -> print_int body - | String -> print_string body - | _ -> print_string "Unknown" + | Msg.Int -> + print_int body + | String -> + print_string body + | _ -> + print_string "Unknown" (* Example of algorithm parametrized with modules *) @@ -917,8 +916,10 @@ module rec Print : sig end = struct let to_string (type s) t x = match t with - | Int eq -> string_of_int (TypEq.apply eq x) - | String eq -> Printf.sprintf "%S" (TypEq.apply eq x) + | Int eq -> + string_of_int (TypEq.apply eq x) + | String eq -> + Printf.sprintf "%S" (TypEq.apply eq x) | Pair p -> let module P = (val p : PAIR with type t = s) in let x1, x2 = TypEq.apply P.eq x in @@ -954,9 +955,12 @@ module type S3 = sig end let f = function - | Some (module M : S3) when M.x -> 1 - | ((Some _) [@foooo]) -> 2 - | None -> 3 + | Some (module M : S3) when M.x -> + 1 + | ((Some _) [@foooo]) -> + 2 + | None -> + 3 ;; print_endline @@ -979,17 +983,15 @@ let fint (type t) (x : t) (tag : t ty) = match tag with Int -> x > 0 (* val fint : 'a -> 'a ty -> bool = <fun> *) -(** OK: the return value is x > 0 of type bool; This has used the equation t - = bool, not visible in the return type **) +(** OK: the return value is x > 0 of type bool; +This has used the equation t = bool, not visible in the return type **) -let f (type t) (x : t) (tag : t ty) = - match tag with Int -> x > 0 | Bool -> x +let f (type t) (x : t) (tag : t ty) = match tag with Int -> x > 0 | Bool -> x (* val f : 'a -> 'a ty -> bool = <fun> *) -let g (type t) (x : t) (tag : t ty) = - match tag with Bool -> x | Int -> x > 0 -(* Error: This expression has type bool but an expression was expected of - type t = int *) +let g (type t) (x : t) (tag : t ty) = match tag with Bool -> x | Int -> x > 0 +(* Error: This expression has type bool but an expression was expected of type +t = int *) let id x = x @@ -1032,11 +1034,14 @@ let rec variantize : type t. t ty -> t -> variant = fun ty x -> (* type t is abstract here *) match ty with - | Int -> VInt x (* in this branch: t = int *) - | String -> VString x (* t = string *) + | Int -> + VInt x (* in this branch: t = int *) + | String -> + VString x (* t = string *) | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a *) - | Pair (ty1, ty2) -> VPair (variantize ty1 (fst x), variantize ty2 (snd x)) + | Pair (ty1, ty2) -> + VPair (variantize ty1 (fst x), variantize ty2 (snd x)) (* t = ('a, 'b) for some 'a and 'b *) exception VariantMismatch @@ -1044,12 +1049,16 @@ exception VariantMismatch let rec devariantize : type t. t ty -> variant -> t = fun ty v -> match (ty, v) with - | Int, VInt x -> x - | String, VString x -> x - | List ty1, VList vl -> List.map (devariantize ty1) vl + | Int, VInt x -> + x + | String, VString x -> + x + | List ty1, VList vl -> + List.map (devariantize ty1) vl | Pair (ty1, ty2), VPair (x1, x2) -> (devariantize ty1 x1, devariantize ty2 x2) - | _ -> raise VariantMismatch + | _ -> + raise VariantMismatch (* Handling records *) @@ -1079,8 +1088,10 @@ let rec variantize : type t. t ty -> t -> variant = fun ty x -> (* type t is abstract here *) match ty with - | Int -> VInt x (* in this branch: t = int *) - | String -> VString x (* t = string *) + | Int -> + VInt x (* in this branch: t = int *) + | String -> + VString x (* t = string *) | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a *) | Pair (ty1, ty2) -> @@ -1112,17 +1123,17 @@ and ('a, 'builder) field = | Field : ('a, 'builder, 'b) field_ -> ('a, 'builder) field and ('a, 'builder, 'b) field_ = - { label: string - ; field_type: 'b ty - ; get: 'a -> 'b - ; set: 'builder -> 'b -> unit } + {label: string; field_type: 'b ty; get: 'a -> 'b; set: 'builder -> 'b -> unit} let rec devariantize : type t. t ty -> variant -> t = fun ty v -> match (ty, v) with - | Int, VInt x -> x - | String, VString x -> x - | List ty1, VList vl -> List.map (devariantize ty1) vl + | Int, VInt x -> + x + | String, VString x -> + x + | List ty1, VList vl -> + List.map (devariantize ty1) vl | Pair (ty1, ty2), VPair (x1, x2) -> (devariantize ty1 x1, devariantize ty2 x2) | Record {fields; create_builder; of_builder}, VRecord fl -> @@ -1134,7 +1145,8 @@ let rec devariantize : type t. t ty -> variant -> t = set builder (devariantize field_type v) ) fields fl ; of_builder builder - | _ -> raise VariantMismatch + | _ -> + raise VariantMismatch type my_record = {a: int; b: string list} @@ -1154,8 +1166,10 @@ let my_record = let create_builder () = (ref None, ref None) in let of_builder (a, b) = match (!a, !b) with - | Some a, Some b -> {a; b} - | _ -> failwith "Some fields are missing in record of type my_record" + | Some a, Some b -> + {a; b} + | _ -> + failwith "Some fields are missing in record of type my_record" in Record {path= "My_module.my_record"; fields; create_builder; of_builder} @@ -1206,31 +1220,37 @@ type _ ty_env = (* Comparing selectors *) type (_, _) eq = Eq : ('a, 'a) eq -let rec eq_sel : type a b c. - (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option = +let rec eq_sel : type a b c. (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option + = fun s1 s2 -> match (s1, s2) with - | Thd, Thd -> Some Eq + | Thd, Thd -> + Some Eq | Ttl s1, Ttl s2 -> ( match eq_sel s1 s2 with None -> None | Some Eq -> Some Eq ) - | _ -> None + | _ -> + None (* Auxiliary function to get the type of a case from its selector *) let rec get_case : type a b e. - (b, a) ty_sel - -> (string * (e, b) ty_case) list - -> string * (a, e) ty option = + (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option + = fun sel cases -> match cases with | (name, TCnoarg sel') :: rem -> ( match eq_sel sel sel' with - | None -> get_case sel rem - | Some Eq -> (name, None) ) + | None -> + get_case sel rem + | Some Eq -> + (name, None) ) | (name, TCarg (sel', ty)) :: rem -> ( match eq_sel sel sel' with - | None -> get_case sel rem - | Some Eq -> (name, Some ty) ) - | [] -> raise Not_found + | None -> + get_case sel rem + | Some Eq -> + (name, Some ty) ) + | [] -> + raise Not_found (* Untyped representation of values *) type variant = @@ -1247,41 +1267,59 @@ let may_map f = function Some x -> Some (f x) | None -> None let rec variantize : type a e. e ty_env -> (a, e) ty -> a -> variant = fun e ty v -> match ty with - | Int -> VInt v - | String -> VString v - | List t -> VList (List.map (variantize e t) v) - | Option t -> VOption (may_map (variantize e t) v) - | Pair (t1, t2) -> VPair (variantize e t1 (fst v), variantize e t2 (snd v)) - | Rec t -> variantize (Econs (ty, e)) t v - | Pop t -> ( match e with Econs (_, e') -> variantize e' t v ) - | Var -> ( match e with Econs (t, e') -> variantize e' t v ) - | Conv (s, proj, inj, t) -> VConv (s, variantize e t (proj v)) + | Int -> + VInt v + | String -> + VString v + | List t -> + VList (List.map (variantize e t) v) + | Option t -> + VOption (may_map (variantize e t) v) + | Pair (t1, t2) -> + VPair (variantize e t1 (fst v), variantize e t2 (snd v)) + | Rec t -> + variantize (Econs (ty, e)) t v + | Pop t -> ( + match e with Econs (_, e') -> variantize e' t v ) + | Var -> ( + match e with Econs (t, e') -> variantize e' t v ) + | Conv (s, proj, inj, t) -> + VConv (s, variantize e t (proj v)) | Sum ops -> let tag, arg = ops.sum_proj v in - VSum - (tag, may_map (function Tdyn (ty, arg) -> variantize e ty arg) arg) + VSum (tag, may_map (function Tdyn (ty, arg) -> variantize e ty arg) arg) let rec devariantize : type t e. e ty_env -> (t, e) ty -> variant -> t = fun e ty v -> match (ty, v) with - | Int, VInt x -> x - | String, VString x -> x - | List ty1, VList vl -> List.map (devariantize e ty1) vl + | Int, VInt x -> + x + | String, VString x -> + x + | List ty1, VList vl -> + List.map (devariantize e ty1) vl | Pair (ty1, ty2), VPair (x1, x2) -> (devariantize e ty1 x1, devariantize e ty2 x2) - | Rec t, _ -> devariantize (Econs (ty, e)) t v - | Pop t, _ -> ( match e with Econs (_, e') -> devariantize e' t v ) - | Var, _ -> ( match e with Econs (t, e') -> devariantize e' t v ) + | Rec t, _ -> + devariantize (Econs (ty, e)) t v + | Pop t, _ -> ( + match e with Econs (_, e') -> devariantize e' t v ) + | Var, _ -> ( + match e with Econs (t, e') -> devariantize e' t v ) | Conv (s, proj, inj, t), VConv (s', v) when s = s' -> inj (devariantize e t v) | Sum ops, VSum (tag, a) -> ( try match (List.assoc tag ops.sum_cases, a) with - | TCarg (sel, t), Some a -> ops.sum_inj (sel, devariantize e t a) - | TCnoarg sel, None -> ops.sum_inj (sel, Noarg) - | _ -> raise VariantMismatch + | TCarg (sel, t), Some a -> + ops.sum_inj (sel, devariantize e t a) + | TCnoarg sel, None -> + ops.sum_inj (sel, Noarg) + | _ -> + raise VariantMismatch with Not_found -> raise VariantMismatch ) - | _ -> raise VariantMismatch + | _ -> + raise VariantMismatch (* First attempt: represent 1-constructor variants using Conv *) let wrap_A t = Conv ("`A", (fun (`A x) -> x), (fun x -> `A x), t) @@ -1307,16 +1345,22 @@ let v = variantize Enil (triple String Int Int) ("A", 2, 3) let ty_abc = (* Could also use [get_case] for proj, but direct definition is shorter *) let proj = function - | `A n -> ("A", Some (Tdyn (Int, n))) - | `B s -> ("B", Some (Tdyn (String, s))) - | `C -> ("C", None) + | `A n -> + ("A", Some (Tdyn (Int, n))) + | `B s -> + ("B", Some (Tdyn (String, s))) + | `C -> + ("C", None) (* Define inj in advance to be able to write the type annotation easily *) and inj : type c. (int -> string -> noarg -> unit, c) ty_sel * c -> [`A of int | `B of string | `C] = function - | Thd, v -> `A v - | Ttl Thd, v -> `B v - | Ttl (Ttl Thd), Noarg -> `C + | Thd, v -> + `A v + | Ttl Thd, v -> + `B v + | Ttl (Ttl Thd), Noarg -> + `C in (* Coherence of sum_inj and sum_cases is checked by the typing *) Sum @@ -1341,8 +1385,10 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = (Sum { sum_proj= (function - | `Nil -> ("Nil", None) - | `Cons p -> ("Cons", Some (Tdyn (tcons, p))) ) + | `Nil -> + ("Nil", None) + | `Cons p -> + ("Cons", Some (Tdyn (tcons, p))) ) ; sum_cases= [("Nil", TCnoarg Thd); ("Cons", TCarg (Ttl Thd, tcons))] ; sum_inj= (fun (type c) -> @@ -1374,14 +1420,21 @@ let ty_abc : ([`A of int | `B of string | `C], 'e) ty = (* Could also use [get_case] for proj, but direct definition is shorter *) Sum ( (function - | `A n -> ("A", Some (Tdyn (Int, n))) - | `B s -> ("B", Some (Tdyn (String, s))) - | `C -> ("C", None) ) + | `A n -> + ("A", Some (Tdyn (Int, n))) + | `B s -> + ("B", Some (Tdyn (String, s))) + | `C -> + ("C", None) ) , function - | "A", Some (Tdyn (Int, n)) -> `A n - | "B", Some (Tdyn (String, s)) -> `B s - | "C", None -> `C - | _ -> invalid_arg "ty_abc" ) + | "A", Some (Tdyn (Int, n)) -> + `A n + | "B", Some (Tdyn (String, s)) -> + `B s + | "C", None -> + `C + | _ -> + invalid_arg "ty_abc" ) (* Breaks: no way to pattern-match on a full recursive type *) let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = @@ -1390,12 +1443,15 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = Rec (Sum ( (function - | `Nil -> ("Nil", None) - | `Cons p -> ("Cons", Some (Tdyn (targ, p))) ) + | `Nil -> + ("Nil", None) + | `Cons p -> + ("Cons", Some (Tdyn (targ, p))) ) , function - | "Nil", None -> `Nil - | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> `Cons p - ) ) + | "Nil", None -> + `Nil + | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> + `Cons p ) ) (* Define Sum using object instead of record for first-class polymorphism *) @@ -1430,9 +1486,12 @@ let ty_abc : (([`A of int | `B of string | `C] as 'a), 'e) ty = (object method proj = function - | `A n -> ("A", Some (Tdyn (Int, n))) - | `B s -> ("B", Some (Tdyn (String, s))) - | `C -> ("C", None) + | `A n -> + ("A", Some (Tdyn (Int, n))) + | `B s -> + ("B", Some (Tdyn (String, s))) + | `C -> + ("C", None) method cases = [ ("A", TCarg (Thd, Int)) @@ -1443,9 +1502,12 @@ let ty_abc : (([`A of int | `B of string | `C] as 'a), 'e) ty = (int -> string -> noarg -> unit, c) ty_sel * c -> [`A of int | `B of string | `C] = function - | Thd, v -> `A v - | Ttl Thd, v -> `B v - | Ttl (Ttl Thd), Noarg -> `C + | Thd, v -> + `A v + | Ttl Thd, v -> + `B v + | Ttl (Ttl Thd), Noarg -> + `C end ) type 'a vlist = [`Nil | `Cons of 'a * 'a vlist] @@ -1458,11 +1520,12 @@ let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = (object method proj = function - | `Nil -> ("Nil", None) - | `Cons p -> ("Cons", Some (Tdyn (tcons, p))) + | `Nil -> + ("Nil", None) + | `Cons p -> + ("Cons", Some (Tdyn (tcons, p))) - method cases = - [("Nil", TCnoarg Thd); ("Cons", TCarg (Ttl Thd, tcons))] + method cases = [("Nil", TCnoarg Thd); ("Cons", TCarg (Ttl Thd, tcons))] method inj : type c. (noarg -> a * a vlist -> unit, c) ty_sel * c -> a vlist = @@ -1513,18 +1576,21 @@ type (_, _, _) plus = | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus let rec length : type a n. (a, n) seq -> n nat = function - | Snil -> NZ - | Scons (_, s) -> NS (length s) + | Snil -> + NZ + | Scons (_, s) -> + NS (length s) -(* app returns the catenated lists with a witness proving that the size is - the sum of its two inputs *) +(* app returns the catenated lists with a witness proving that + the size is the sum of its two inputs *) type (_, _, _) app = | App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app let rec app : type a n m. (a, n) seq -> (a, m) seq -> (a, n, m) app = fun xs ys -> match xs with - | Snil -> App (ys, PlusZ (length ys)) + | Snil -> + App (ys, PlusZ (length ys)) | Scons (x, xs') -> let (App (xs'', pl)) = app xs' ys in App (Scons (x, xs''), PlusS pl) @@ -1569,8 +1635,10 @@ let rec find : type sh. ('a -> 'a -> bool) -> 'a -> (sh, 'a) tree -> (sh, 'a) path list = fun eq n t -> match t with - | Ttip -> [] - | Tnode m -> if eq n m then [Phere] else [] + | Ttip -> + [] + | Tnode m -> + if eq n m then [Phere] else [] | Tfork (x, y) -> List.map (fun x -> Pleft x) (find eq n x) @ List.map (fun x -> Pright x) (find eq n y) @@ -1578,10 +1646,14 @@ let rec find : type sh. let rec extract : type sh. (sh, 'a) path -> (sh, 'a) tree -> 'a = fun p t -> match (p, t) with - | Pnone x, Ttip -> x - | Phere, Tnode y -> y - | Pleft p, Tfork (l, _) -> extract p l - | Pright p, Tfork (_, r) -> extract p r + | Pnone x, Ttip -> + x + | Phere, Tnode y -> + y + | Pleft p, Tfork (l, _) -> + extract p l + | Pright p, Tfork (_, r) -> + extract p r (* 3.4 Pattern : Witness *) @@ -1620,10 +1692,12 @@ let convert : type a b. (a, b) equal -> a -> b = fun Eq x -> x let rec sameNat : type a b. a nat -> b nat -> (a, b) equal option = fun a b -> match (a, b) with - | NZ, NZ -> Some Eq + | NZ, NZ -> + Some Eq | NS a', NS b' -> ( match sameNat a' b' with Some Eq -> Some Eq | None -> None ) - | _ -> None + | _ -> + None (* Extra: associativity of addition *) @@ -1631,7 +1705,8 @@ let rec plus_func : type a b m n. (a, b, m) plus -> (a, b, n) plus -> (m, n) equal = fun p1 p2 -> match (p1, p2) with - | PlusZ _, PlusZ _ -> Eq + | PlusZ _, PlusZ _ -> + Eq | PlusS p1', PlusS p2' -> let Eq = plus_func p1' p2' in Eq @@ -1656,20 +1731,26 @@ let rec plus_assoc : type a b c ab bc m n. (* Plus and app1 are moved to section 2 *) -let smaller : type a b. (a succ, b succ) le -> (a, b) le = function - | LeS x -> x +let smaller : type a b. (a succ, b succ) le -> (a, b) le = function LeS x -> x type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff -(* let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff = fun le - a b -> match a, b, le with | NZ, m, _ -> Diff (m, PlusZ m) | NS x, NZ, _ - -> assert false | NS x, NS y, q -> match diff (smaller q) x y with Diff - (m, p) -> Diff (m, PlusS p) ;; *) +(* +let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff = + fun le a b -> + match a, b, le with + | NZ, m, _ -> Diff (m, PlusZ m) + | NS x, NZ, _ -> assert false + | NS x, NS y, q -> + match diff (smaller q) x y with Diff (m, p) -> Diff (m, PlusS p) +;; +*) let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff = fun le a b -> match (le, a, b) with - | LeZ _, _, m -> Diff (m, PlusZ m) + | LeZ _, _, m -> + Diff (m, PlusZ m) | LeS q, NS x, NS y -> ( match diff q x y with Diff (m, p) -> Diff (m, PlusS p) ) @@ -1677,32 +1758,38 @@ let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff = fun le a b -> match (a, b, le) with (* warning *) - | NZ, m, LeZ _ -> Diff (m, PlusZ m) + | NZ, m, LeZ _ -> + Diff (m, PlusZ m) | NS x, NS y, LeS q -> ( match diff q x y with Diff (m, p) -> Diff (m, PlusS p) ) - | _ -> . + | _ -> + . let rec diff : type a b. (a, b) le -> b nat -> (a, b) diff = fun le b -> match (b, le) with - | m, LeZ _ -> Diff (m, PlusZ m) - | NS y, LeS q -> ( match diff q y with Diff (m, p) -> Diff (m, PlusS p) ) + | m, LeZ _ -> + Diff (m, PlusZ m) + | NS y, LeS q -> ( + match diff q y with Diff (m, p) -> Diff (m, PlusS p) ) type (_, _) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter let rec leS' : type m n. (m, n) le -> (m, n succ) le = function - | LeZ n -> LeZ (NS n) - | LeS le -> LeS (leS' le) + | LeZ n -> + LeZ (NS n) + | LeS le -> + LeS (leS' le) let rec filter : type a n. (a -> bool) -> (a, n) seq -> (a, n) filter = fun f s -> match s with - | Snil -> Filter (LeZ NZ, Snil) + | Snil -> + Filter (LeZ NZ, Snil) | Scons (a, l) -> ( match filter f l with | Filter (le, l') -> - if f a then Filter (LeS le, Scons (a, l')) else Filter (leS' le, l') - ) + if f a then Filter (LeS le, Scons (a, l')) else Filter (leS' le, l') ) (* 4.1 AVL trees *) @@ -1713,9 +1800,7 @@ type (_, _, _) balance = type _ avl = | Leaf : zero avl - | Node : - ('hL, 'hR, 'hMax) balance * 'hL avl * int * 'hR avl - -> 'hMax succ avl + | Node : ('hL, 'hR, 'hMax) balance * 'hL avl * int * 'hR avl -> 'hMax succ avl type avl' = Avl : 'h avl -> avl' @@ -1724,8 +1809,10 @@ let empty = Avl Leaf let rec elem : type h. int -> h avl -> bool = fun x t -> match t with - | Leaf -> false - | Node (_, l, y, r) -> x = y || if x < y then elem x l else elem x r + | Leaf -> + false + | Node (_, l, y, r) -> + x = y || if x < y then elem x l else elem x r let rec rotr : type n. n succ succ avl @@ -1734,8 +1821,10 @@ let rec rotr : type n. -> (n succ succ avl, n succ succ succ avl) sum = fun tL y tR -> match tL with - | Node (Same, a, x, b) -> Inr (Node (Less, a, x, Node (More, b, y, tR))) - | Node (More, a, x, b) -> Inl (Node (Same, a, x, Node (Same, b, y, tR))) + | Node (Same, a, x, b) -> + Inr (Node (Less, a, x, Node (More, b, y, tR))) + | Node (More, a, x, b) -> + Inl (Node (Same, a, x, Node (Same, b, y, tR))) | Node (Less, a, x, Node (Same, b, z, c)) -> Inl (Node (Same, Node (Same, a, x, b), z, Node (Same, c, y, tR))) | Node (Less, a, x, Node (Less, b, z, c)) -> @@ -1750,8 +1839,10 @@ let rec rotl : type n. -> (n succ succ avl, n succ succ succ avl) sum = fun tL u tR -> match tR with - | Node (Same, a, x, b) -> Inr (Node (More, Node (Less, tL, u, a), x, b)) - | Node (Less, a, x, b) -> Inl (Node (Same, Node (Same, tL, u, a), x, b)) + | Node (Same, a, x, b) -> + Inr (Node (More, Node (Less, tL, u, a), x, b)) + | Node (Less, a, x, b) -> + Inl (Node (Same, Node (Same, tL, u, a), x, b)) | Node (More, Node (Same, a, x, b), y, c) -> Inl (Node (Same, Node (Same, tL, u, a), x, Node (Same, b, y, c))) | Node (More, Node (Less, a, x, b), y, c) -> @@ -1762,41 +1853,55 @@ let rec rotl : type n. let rec ins : type n. int -> n avl -> (n avl, n succ avl) sum = fun x t -> match t with - | Leaf -> Inr (Node (Same, Leaf, x, Leaf)) + | Leaf -> + Inr (Node (Same, Leaf, x, Leaf)) | Node (bal, a, y, b) -> ( if x = y then Inl t else if x < y then match ins x a with - | Inl a -> Inl (Node (bal, a, y, b)) + | Inl a -> + Inl (Node (bal, a, y, b)) | Inr a -> ( match bal with - | Less -> Inl (Node (Same, a, y, b)) - | Same -> Inr (Node (More, a, y, b)) - | More -> rotr a y b ) + | Less -> + Inl (Node (Same, a, y, b)) + | Same -> + Inr (Node (More, a, y, b)) + | More -> + rotr a y b ) else match ins x b with - | Inl b -> Inl (Node (bal, a, y, b) : n avl) + | Inl b -> + Inl (Node (bal, a, y, b) : n avl) | Inr b -> ( match bal with - | More -> Inl (Node (Same, a, y, b) : n avl) - | Same -> Inr (Node (Less, a, y, b) : n succ avl) - | Less -> rotl a y b ) ) + | More -> + Inl (Node (Same, a, y, b) : n avl) + | Same -> + Inr (Node (Less, a, y, b) : n succ avl) + | Less -> + rotl a y b ) ) let insert x (Avl t) = match ins x t with Inl t -> Avl t | Inr t -> Avl t -let rec del_min : type n. n succ avl -> int * (n avl, n succ avl) sum = - function - | Node (Less, Leaf, x, r) -> (x, Inl r) - | Node (Same, Leaf, x, r) -> (x, Inl r) +let rec del_min : type n. n succ avl -> int * (n avl, n succ avl) sum = function + | Node (Less, Leaf, x, r) -> + (x, Inl r) + | Node (Same, Leaf, x, r) -> + (x, Inl r) | Node (bal, (Node _ as l), x, r) -> ( match del_min l with - | y, Inr l -> (y, Inr (Node (bal, l, x, r))) + | y, Inr l -> + (y, Inr (Node (bal, l, x, r))) | y, Inl l -> ( y , match bal with - | Same -> Inr (Node (Less, l, x, r)) - | More -> Inl (Node (Same, l, x, r)) - | Less -> rotl l x r ) ) + | Same -> + Inr (Node (Less, l, x, r)) + | More -> + Inl (Node (Same, l, x, r)) + | Less -> + rotl l x r ) ) type _ avl_del = | Dsame : 'n avl -> 'n avl_del @@ -1805,7 +1910,8 @@ type _ avl_del = let rec del : type n. int -> n avl -> n avl_del = fun y t -> match t with - | Leaf -> Dsame Leaf + | Leaf -> + Dsame Leaf | Node (bal, l, x, r) -> ( if x = y then match r with @@ -1813,32 +1919,39 @@ let rec del : type n. int -> n avl -> n avl_del = match bal with Same -> Ddecr (Eq, l) | More -> Ddecr (Eq, l) ) | Node _ -> ( match (bal, del_min r) with - | _, (z, Inr r) -> Dsame (Node (bal, l, z, r)) - | Same, (z, Inl r) -> Dsame (Node (More, l, z, r)) - | Less, (z, Inl r) -> Ddecr (Eq, Node (Same, l, z, r)) + | _, (z, Inr r) -> + Dsame (Node (bal, l, z, r)) + | Same, (z, Inl r) -> + Dsame (Node (More, l, z, r)) + | Less, (z, Inl r) -> + Ddecr (Eq, Node (Same, l, z, r)) | More, (z, Inl r) -> ( - match rotr l z r with Inl t -> Ddecr (Eq, t) | Inr t -> Dsame t ) - ) + match rotr l z r with Inl t -> Ddecr (Eq, t) | Inr t -> Dsame t ) ) else if y < x then match del y l with - | Dsame l -> Dsame (Node (bal, l, x, r)) + | Dsame l -> + Dsame (Node (bal, l, x, r)) | Ddecr (Eq, l) -> ( match bal with - | Same -> Dsame (Node (Less, l, x, r)) - | More -> Ddecr (Eq, Node (Same, l, x, r)) + | Same -> + Dsame (Node (Less, l, x, r)) + | More -> + Ddecr (Eq, Node (Same, l, x, r)) | Less -> ( - match rotl l x r with Inl t -> Ddecr (Eq, t) | Inr t -> Dsame t ) - ) + match rotl l x r with Inl t -> Ddecr (Eq, t) | Inr t -> Dsame t ) ) else match del y r with - | Dsame r -> Dsame (Node (bal, l, x, r)) + | Dsame r -> + Dsame (Node (bal, l, x, r)) | Ddecr (Eq, r) -> ( match bal with - | Same -> Dsame (Node (More, l, x, r)) - | Less -> Ddecr (Eq, Node (Same, l, x, r)) + | Same -> + Dsame (Node (More, l, x, r)) + | Less -> + Ddecr (Eq, Node (Same, l, x, r)) | More -> ( - match rotr l x r with Inl t -> Ddecr (Eq, t) | Inr t -> Dsame t ) - ) ) + match rotr l x r with Inl t -> Ddecr (Eq, t) | Inr t -> Dsame t ) ) + ) let delete x (Avl t) = match del x t with Dsame t -> Avl t | Ddecr (_, t) -> Avl t @@ -1864,9 +1977,7 @@ type dir = LeftD | RightD type (_, _) ctxt = | CNil : (black, 'n) ctxt - | CRed : - int * dir * (black, 'n) sub_tree * (red, 'n) ctxt - -> (black, 'n) ctxt + | CRed : int * dir * (black, 'n) sub_tree * (red, 'n) ctxt -> (black, 'n) ctxt | CBlk : int * dir * ('c1, 'n) sub_tree * (black, 'n succ) ctxt -> ('c, 'n) ctxt @@ -1876,43 +1987,64 @@ let blacken = function Rnode (l, e, r) -> Bnode (l, e, r) type _ crep = Red : red crep | Black : black crep let color : type c n. (c, n) sub_tree -> c crep = function - | Bleaf -> Black - | Rnode _ -> Red - | Bnode _ -> Black + | Bleaf -> + Black + | Rnode _ -> + Red + | Bnode _ -> + Black let rec fill : type c n. (c, n) ctxt -> (c, n) sub_tree -> rb_tree = fun ct t -> match ct with - | CNil -> Root t - | CRed (e, LeftD, uncle, c) -> fill c (Rnode (uncle, e, t)) - | CRed (e, RightD, uncle, c) -> fill c (Rnode (t, e, uncle)) - | CBlk (e, LeftD, uncle, c) -> fill c (Bnode (uncle, e, t)) - | CBlk (e, RightD, uncle, c) -> fill c (Bnode (t, e, uncle)) + | CNil -> + Root t + | CRed (e, LeftD, uncle, c) -> + fill c (Rnode (uncle, e, t)) + | CRed (e, RightD, uncle, c) -> + fill c (Rnode (t, e, uncle)) + | CBlk (e, LeftD, uncle, c) -> + fill c (Bnode (uncle, e, t)) + | CBlk (e, RightD, uncle, c) -> + fill c (Bnode (t, e, uncle)) let recolor d1 pE sib d2 gE uncle t = match (d1, d2) with - | LeftD, RightD -> Rnode (Bnode (sib, pE, t), gE, uncle) - | RightD, RightD -> Rnode (Bnode (t, pE, sib), gE, uncle) - | LeftD, LeftD -> Rnode (uncle, gE, Bnode (sib, pE, t)) - | RightD, LeftD -> Rnode (uncle, gE, Bnode (t, pE, sib)) + | LeftD, RightD -> + Rnode (Bnode (sib, pE, t), gE, uncle) + | RightD, RightD -> + Rnode (Bnode (t, pE, sib), gE, uncle) + | LeftD, LeftD -> + Rnode (uncle, gE, Bnode (sib, pE, t)) + | RightD, LeftD -> + Rnode (uncle, gE, Bnode (t, pE, sib)) let rotate d1 pE sib d2 gE uncle (Rnode (x, e, y)) = match (d1, d2) with - | RightD, RightD -> Bnode (Rnode (x, e, y), pE, Rnode (sib, gE, uncle)) - | LeftD, RightD -> Bnode (Rnode (sib, pE, x), e, Rnode (y, gE, uncle)) - | LeftD, LeftD -> Bnode (Rnode (uncle, gE, sib), pE, Rnode (x, e, y)) - | RightD, LeftD -> Bnode (Rnode (uncle, gE, x), e, Rnode (y, pE, sib)) + | RightD, RightD -> + Bnode (Rnode (x, e, y), pE, Rnode (sib, gE, uncle)) + | LeftD, RightD -> + Bnode (Rnode (sib, pE, x), e, Rnode (y, gE, uncle)) + | LeftD, LeftD -> + Bnode (Rnode (uncle, gE, sib), pE, Rnode (x, e, y)) + | RightD, LeftD -> + Bnode (Rnode (uncle, gE, x), e, Rnode (y, pE, sib)) let rec repair : type c n. (red, n) sub_tree -> (c, n) ctxt -> rb_tree = fun t ct -> match ct with - | CNil -> Root (blacken t) - | CBlk (e, LeftD, sib, c) -> fill c (Bnode (sib, e, t)) - | CBlk (e, RightD, sib, c) -> fill c (Bnode (t, e, sib)) + | CNil -> + Root (blacken t) + | CBlk (e, LeftD, sib, c) -> + fill c (Bnode (sib, e, t)) + | CBlk (e, RightD, sib, c) -> + fill c (Bnode (t, e, sib)) | CRed (e, dir, sib, CBlk (e', dir', uncle, ct)) -> ( match color uncle with - | Red -> repair (recolor dir e sib dir' e' (blacken uncle) t) ct - | Black -> fill ct (rotate dir e sib dir' e' uncle t) ) + | Red -> + repair (recolor dir e sib dir' e' (blacken uncle) t) ct + | Black -> + fill ct (rotate dir e sib dir' e' uncle t) ) let rec ins : type c n. int -> (c, n) sub_tree -> (c, n) ctxt -> rb_tree = fun e t ct -> @@ -1923,7 +2055,8 @@ let rec ins : type c n. int -> (c, n) sub_tree -> (c, n) ctxt -> rb_tree = | Bnode (l, e', r) -> if e < e' then ins e l (CBlk (e', RightD, r, ct)) else ins e r (CBlk (e', LeftD, l, ct)) - | Bleaf -> repair (Rnode (Bleaf, e, Bleaf)) ct + | Bleaf -> + repair (Rnode (Bleaf, e, Bleaf)) ct let insert e (Root t) = ins e t CNil @@ -1941,11 +2074,16 @@ let ex1 = Ap (Add, Pair (Const 3, Const 5)) let ex2 = Pair (ex1, Const 1) let rec eval_term : type a. a term -> a = function - | Const x -> x - | Add -> fun (x, y) -> x + y - | LT -> fun (x, y) -> x < y - | Ap (f, x) -> eval_term f (eval_term x) - | Pair (x, y) -> (eval_term x, eval_term y) + | Const x -> + x + | Add -> + fun (x, y) -> x + y + | LT -> + fun (x, y) -> x < y + | Ap (f, x) -> + eval_term f (eval_term x) + | Pair (x, y) -> + (eval_term x, eval_term y) type _ rep = | Rint : int rep @@ -1958,30 +2096,38 @@ type (_, _) equal = Eq : ('a, 'a) equal let rec rep_equal : type a b. a rep -> b rep -> (a, b) equal option = fun ra rb -> match (ra, rb) with - | Rint, Rint -> Some Eq - | Rbool, Rbool -> Some Eq + | Rint, Rint -> + Some Eq + | Rbool, Rbool -> + Some Eq | Rpair (a1, a2), Rpair (b1, b2) -> ( match rep_equal a1 b1 with - | None -> None + | None -> + None | Some Eq -> ( match rep_equal a2 b2 with None -> None | Some Eq -> Some Eq ) ) | Rfun (a1, a2), Rfun (b1, b2) -> ( match rep_equal a1 b1 with - | None -> None + | None -> + None | Some Eq -> ( match rep_equal a2 b2 with None -> None | Some Eq -> Some Eq ) ) - | _ -> None + | _ -> + None type assoc = Assoc : string * 'a rep * 'a -> assoc let rec assoc : type a. string -> a rep -> assoc list -> a = fun x r -> function - | [] -> raise Not_found + | [] -> + raise Not_found | Assoc (x', r', v) :: env -> if x = x' then match rep_equal r r' with - | None -> failwith ("Wrong type for " ^ x) - | Some Eq -> v + | None -> + failwith ("Wrong type for " ^ x) + | Some Eq -> + v else assoc x r env type _ term = @@ -1995,13 +2141,20 @@ type _ term = let rec eval_term : type a. assoc list -> a term -> a = fun env -> function - | Var (x, r) -> assoc x r env - | Abs (x, r, e) -> fun v -> eval_term (Assoc (x, r, v) :: env) e - | Const x -> x - | Add -> fun (x, y) -> x + y - | LT -> fun (x, y) -> x < y - | Ap (f, x) -> eval_term env f (eval_term env x) - | Pair (x, y) -> (eval_term env x, eval_term env y) + | Var (x, r) -> + assoc x r env + | Abs (x, r, e) -> + fun v -> eval_term (Assoc (x, r, v) :: env) e + | Const x -> + x + | Add -> + fun (x, y) -> x + y + | LT -> + fun (x, y) -> x < y + | Ap (f, x) -> + eval_term env f (eval_term env x) + | Pair (x, y) -> + (eval_term env x, eval_term env y) let ex3 = Abs ("x", Rint, Ap (Add, Pair (Var ("x", Rint), Var ("x", Rint)))) @@ -2041,11 +2194,16 @@ type _ env = let rec eval_lam : type e t. e env -> (e, t) lam -> t = fun env m -> match (env, m) with - | _, Const n -> n - | Econs (_, v, r), Var _ -> v - | Econs (_, _, r), Shift e -> eval_lam r e - | _, Abs (n, body) -> fun x -> eval_lam (Econs (n, x, env)) body - | _, App (f, x) -> eval_lam env f (eval_lam env x) + | _, Const n -> + n + | Econs (_, v, r), Var _ -> + v + | Econs (_, _, r), Shift e -> + eval_lam r e + | _, Abs (n, body) -> + fun x -> eval_lam (Econs (n, x, env)) body + | _, App (f, x) -> + eval_lam env f (eval_lam env x) type add = Add @@ -2073,22 +2231,26 @@ let v3 = eval_lam env0 ex3 (* 5.13: Constructing typing derivations at runtime *) -(* Modified slightly to use the language of 5.10, since this is more fun. Of - course this works also with the language of 5.12. *) +(* Modified slightly to use the language of 5.10, since this is more fun. + Of course this works also with the language of 5.12. *) type _ rep = I : int rep | Ar : 'a rep * 'b rep -> ('a -> 'b) rep let rec compare : type a b. a rep -> b rep -> (string, (a, b) equal) sum = fun a b -> match (a, b) with - | I, I -> Inr Eq + | I, I -> + Inr Eq | Ar (x, y), Ar (s, t) -> ( match compare x s with - | Inl _ as e -> e + | Inl _ as e -> + e | Inr Eq -> ( match compare y t with Inl _ as e -> e | Inr Eq as e -> e ) ) - | I, Ar _ -> Inl "I <> Ar _" - | Ar _, I -> Inl "Ar _ <> I" + | I, Ar _ -> + Inl "I <> Ar _" + | Ar _, I -> + Inl "Ar _ <> I" type term = | C of int @@ -2100,51 +2262,60 @@ type _ ctx = | Cnil : rnil ctx | Ccons : 't * string * 'x rep * 'e ctx -> ('t, 'x, 'e) rcons ctx -type _ checked = - | Cerror of string - | Cok : ('e, 't) lam * 't rep -> 'e checked +type _ checked = Cerror of string | Cok : ('e, 't) lam * 't rep -> 'e checked let rec lookup : type e. string -> e ctx -> e checked = fun name ctx -> match ctx with - | Cnil -> Cerror ("Name not found: " ^ name) + | Cnil -> + Cerror ("Name not found: " ^ name) | Ccons (l, s, t, rs) -> ( if s = name then Cok (Var l, t) else match lookup name rs with - | Cerror m -> Cerror m - | Cok (v, t) -> Cok (Shift v, t) ) + | Cerror m -> + Cerror m + | Cok (v, t) -> + Cok (Shift v, t) ) let rec tc : type n e. n nat -> e ctx -> term -> e checked = fun n ctx t -> match t with - | V s -> lookup s ctx + | V s -> + lookup s ctx | Ap (f, x) -> ( match tc n ctx f with - | Cerror _ as e -> e + | Cerror _ as e -> + e | Cok (f', ft) -> ( match tc n ctx x with - | Cerror _ as e -> e + | Cerror _ as e -> + e | Cok (x', xt) -> ( match ft with | Ar (a, b) -> ( match compare a xt with - | Inl s -> Cerror s - | Inr Eq -> Cok (App (f', x'), b) ) - | _ -> Cerror "Non fun in Ap" ) ) ) + | Inl s -> + Cerror s + | Inr Eq -> + Cok (App (f', x'), b) ) + | _ -> + Cerror "Non fun in Ap" ) ) ) | Ab (s, t, body) -> ( match tc (NS n) (Ccons (n, s, t, ctx)) body with - | Cerror _ as e -> e - | Cok (body', et) -> Cok (Abs (n, body'), Ar (t, et)) ) - | C m -> Cok (Const m, I) + | Cerror _ as e -> + e + | Cok (body', et) -> + Cok (Abs (n, body'), Ar (t, et)) ) + | C m -> + Cok (Const m, I) let ctx0 = Ccons ( Zero , "0" , I - , Ccons (Suc, "S", Ar (I, I), Ccons (Add, "+", Ar (I, Ar (I, I)), Cnil)) - ) + , Ccons (Suc, "S", Ar (I, I), Ccons (Add, "+", Ar (I, Ar (I, I)), Cnil)) ) let ex1 = Ab ("x", I, Ap (Ap (V "+", V "x"), V "x")) @@ -2155,9 +2326,12 @@ let ex2 = Ap (ex1, C 3) let c2 = tc NZ ctx0 ex2 let eval_checked env = function - | Cerror s -> failwith s - | Cok (e, I) -> (eval_lam env e : int) - | Cok _ -> failwith "Can only evaluate expressions of type I" + | Cerror s -> + failwith s + | Cok (e, I) -> + (eval_lam env e : int) + | Cok _ -> + failwith "Can only evaluate expressions of type I" let v2 = eval_checked env0 c2 @@ -2181,21 +2355,22 @@ type (_, _, _) lam = | Const : ('a, 'b) rel * 'b -> (pval, 'env, 'a) lam | Var : 'a -> (pval, ('a, 't, 'e) rcons, 't) lam | Shift : ('m, 'e, 't) lam -> ('m, ('a, 'q, 'e) rcons, 't) lam - | Lam : - 'a * ('m, ('a, 's, 'e) rcons, 't) lam - -> (pval, 'e, ('s, 't) tarr) lam - | App : - ('m1, 'e, ('s, 't) tarr) lam * ('m2, 'e, 's) lam - -> (pexp, 'e, 't) lam + | Lam : 'a * ('m, ('a, 's, 'e) rcons, 't) lam -> (pval, 'e, ('s, 't) tarr) lam + | App : ('m1, 'e, ('s, 't) tarr) lam * ('m2, 'e, 's) lam -> (pexp, 'e, 't) lam let ex1 = App (Lam (X, Var X), Const (IntR, 3)) let rec mode : type m e t. (m, e, t) lam -> m mode = function - | Lam (v, body) -> Pval - | Var v -> Pval - | Const (r, v) -> Pval - | Shift e -> mode e - | App _ -> Pexp + | Lam (v, body) -> + Pval + | Var v -> + Pval + | Const (r, v) -> + Pval + | Shift e -> + mode e + | App _ -> + Pexp type (_, _) sub = | Id : ('r, 'r) sub @@ -2209,12 +2384,18 @@ type (_, _) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam' let rec subst : type m1 r t s. (m1, r, t) lam -> (r, s) sub -> (s, t) lam' = fun t s -> match (t, s) with - | _, Id -> Ex t - | Const (r, c), sub -> Ex (Const (r, c)) - | Var v, Bind (x, e, r) -> Ex e - | Var v, Push sub -> Ex (Var v) - | Shift e, Bind (_, _, r) -> subst e r - | Shift e, Push sub -> ( match subst e sub with Ex a -> Ex (Shift a) ) + | _, Id -> + Ex t + | Const (r, c), sub -> + Ex (Const (r, c)) + | Var v, Bind (x, e, r) -> + Ex e + | Var v, Push sub -> + Ex (Var v) + | Shift e, Bind (_, _, r) -> + subst e r + | Shift e, Push sub -> ( + match subst e sub with Ex a -> Ex (Shift a) ) | App (f, x), sub -> ( match (subst f sub, subst x sub) with Ex g, Ex y -> Ex (App (g, y)) ) | Lam (v, x), sub -> ( @@ -2232,22 +2413,30 @@ let rec rule : type a b. match subst body (Bind (x, v, Id)) with | Ex term -> ( match mode term with Pexp -> Inl term | Pval -> Inr term ) ) - | Const (IntTo b, f), Const (IntR, x) -> Inr (Const (b, f x)) + | Const (IntTo b, f), Const (IntR, x) -> + Inr (Const (b, f x)) let rec onestep : type m t. (m, closed, t) lam -> t rlam = function - | Lam (v, body) -> Inr (Lam (v, body)) - | Const (r, v) -> Inr (Const (r, v)) + | Lam (v, body) -> + Inr (Lam (v, body)) + | Const (r, v) -> + Inr (Const (r, v)) | App (e1, e2) -> ( match (mode e1, mode e2) with | Pexp, _ -> ( match onestep e1 with - | Inl e -> Inl (App (e, e2)) - | Inr v -> Inl (App (v, e2)) ) + | Inl e -> + Inl (App (e, e2)) + | Inr v -> + Inl (App (v, e2)) ) | Pval, Pexp -> ( match onestep e2 with - | Inl e -> Inl (App (e1, e)) - | Inr v -> Inl (App (e1, v)) ) - | Pval, Pval -> rule e1 e2 ) + | Inl e -> + Inl (App (e1, e)) + | Inr v -> + Inl (App (e1, v)) ) + | Pval, Pval -> + rule e1 e2 ) type ('env, 'a) var = | Zero : ('a * 'env, 'a) var @@ -2261,10 +2450,14 @@ type ('env, 'a) typ = let f : type env a. (env, a) typ -> (env, a) typ -> int = fun ta tb -> match (ta, tb) with - | Tint, Tint -> 0 - | Tbool, Tbool -> 1 - | Tvar var, tb -> 2 - | _ -> . (* error *) + | Tint, Tint -> + 0 + | Tbool, Tbool -> + 1 + | Tvar var, tb -> + 2 + | _ -> + . (* error *) (* let x = f Tint (Tvar Zero) ;; *) type inkind = [`Link | `Nonlink] @@ -2277,10 +2470,14 @@ type _ inline_t = let uppercase seq = let rec process : type a. a inline_t -> a inline_t = function - | Text txt -> Text (String.uppercase_ascii txt) - | Bold xs -> Bold (List.map process xs) - | Link lnk -> Link lnk - | Mref (lnk, xs) -> Mref (lnk, List.map process xs) + | Text txt -> + Text (String.uppercase_ascii txt) + | Bold xs -> + Bold (List.map process xs) + | Link lnk -> + Link lnk + | Mref (lnk, xs) -> + Mref (lnk, List.map process xs) in List.map process seq @@ -2292,15 +2489,22 @@ type ast_t = let inlineseq_from_astseq seq = let rec process_nonlink = function - | Ast_Text txt -> Text txt - | Ast_Bold xs -> Bold (List.map process_nonlink xs) - | _ -> assert false + | Ast_Text txt -> + Text txt + | Ast_Bold xs -> + Bold (List.map process_nonlink xs) + | _ -> + assert false in let rec process_any = function - | Ast_Text txt -> Text txt - | Ast_Bold xs -> Bold (List.map process_any xs) - | Ast_Link lnk -> Link lnk - | Ast_Mref (lnk, xs) -> Mref (lnk, List.map process_nonlink xs) + | Ast_Text txt -> + Text txt + | Ast_Bold xs -> + Bold (List.map process_any xs) + | Ast_Link lnk -> + Link lnk + | Ast_Mref (lnk, xs) -> + Mref (lnk, List.map process_nonlink xs) in List.map process_any seq @@ -2311,13 +2515,20 @@ let inlineseq_from_astseq seq = let rec process : type a. a linkp -> ast_t -> a inline_t = fun allow_link ast -> match (allow_link, ast) with - | Maylink, Ast_Text txt -> Text txt - | Nonlink, Ast_Text txt -> Text txt - | x, Ast_Bold xs -> Bold (List.map (process x) xs) - | Maylink, Ast_Link lnk -> Link lnk - | Nonlink, Ast_Link _ -> assert false - | Maylink, Ast_Mref (lnk, xs) -> Mref (lnk, List.map (process Nonlink) xs) - | Nonlink, Ast_Mref _ -> assert false + | Maylink, Ast_Text txt -> + Text txt + | Nonlink, Ast_Text txt -> + Text txt + | x, Ast_Bold xs -> + Bold (List.map (process x) xs) + | Maylink, Ast_Link lnk -> + Link lnk + | Nonlink, Ast_Link _ -> + assert false + | Maylink, Ast_Mref (lnk, xs) -> + Mref (lnk, List.map (process Nonlink) xs) + | Nonlink, Ast_Mref _ -> + assert false in List.map (process Maylink) seq @@ -2328,13 +2539,18 @@ let inlineseq_from_astseq seq = let rec process : type a. a linkp2 -> ast_t -> a inline_t = fun allow_link ast -> match (allow_link, ast) with - | Kind _, Ast_Text txt -> Text txt - | x, Ast_Bold xs -> Bold (List.map (process x) xs) - | Kind Maylink, Ast_Link lnk -> Link lnk - | Kind Nonlink, Ast_Link _ -> assert false + | Kind _, Ast_Text txt -> + Text txt + | x, Ast_Bold xs -> + Bold (List.map (process x) xs) + | Kind Maylink, Ast_Link lnk -> + Link lnk + | Kind Nonlink, Ast_Link _ -> + assert false | Kind Maylink, Ast_Mref (lnk, xs) -> Mref (lnk, List.map (process (Kind Nonlink)) xs) - | Kind Nonlink, Ast_Mref _ -> assert false + | Kind Nonlink, Ast_Mref _ -> + assert false in List.map (process (Kind Maylink)) seq @@ -2345,8 +2561,10 @@ struct type _ t = One : [`One] t | Two : T.two t let add (type a) : a t * a t -> string = function - | One, One -> "two" - | Two, Two -> "four" + | One, One -> + "two" + | Two, Two -> + "four" end module B : sig @@ -2371,10 +2589,14 @@ type (_, _, _) binop = let eval (type a) (type b) (type c) (bop : (a, b, c) binop) (x : a constant) (y : b constant) : c constant = match (bop, x, y) with - | Eq, Bool x, Bool y -> Bool (if x then y else not y) - | Leq, Int x, Int y -> Bool (x <= y) - | Leq, Bool x, Bool y -> Bool (x <= y) - | Add, Int x, Int y -> Int (x + y) + | Eq, Bool x, Bool y -> + Bool (if x then y else not y) + | Leq, Int x, Int y -> + Bool (x <= y) + | Leq, Bool x, Bool y -> + Bool (x <= y) + | Add, Int x, Int y -> + Int (x + y) let _ = eval Eq (Int 2) (Int 3) @@ -2397,8 +2619,10 @@ type _ wrapPoly = let example6 : type a. a wrapPoly -> a -> int = fun w -> match w with - | WrapPoly ATag -> intA - | WrapPoly _ -> intA (* This should not be allowed *) + | WrapPoly ATag -> + intA + | WrapPoly _ -> + intA (* This should not be allowed *) let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *) @@ -2517,16 +2741,20 @@ type aux = let f (Aux x) = match x with - | Succ Zero -> "1" - | Succ (Succ Zero) -> "2" - | Succ (Succ (Succ Zero)) -> "3" - | Succ (Succ (Succ (Succ Zero))) -> "4" - | _ -> . (* error *) + | Succ Zero -> + "1" + | Succ (Succ Zero) -> + "2" + | Succ (Succ (Succ Zero)) -> + "3" + | Succ (Succ (Succ (Succ Zero))) -> + "4" + | _ -> + . (* error *) type _ t = C : ((('a -> 'o) -> 'o) -> ('b -> 'o) -> 'o) t -let f : type a o. ((a -> o) -> o) t -> (a -> o) -> o = - fun C k -> k (fun x -> x) +let f : type a o. ((a -> o) -> o) t -> (a -> o) -> o = fun C k -> k (fun x -> x) type (_, _) t = A : ('a, 'a) t | B : string -> ('a, 'b) t @@ -2559,18 +2787,24 @@ type ('a, 'result, 'visit_action) context = let vexpr (type visit_action) : (_, _, visit_action) context -> _ -> visit_action = function - | Local -> fun _ -> raise Exit - | Global -> fun _ -> raise Exit + | Local -> + fun _ -> raise Exit + | Global -> + fun _ -> raise Exit let vexpr (type visit_action) : ('a, 'result, visit_action) context -> 'a -> visit_action = function - | Local -> fun _ -> raise Exit - | Global -> fun _ -> raise Exit + | Local -> + fun _ -> raise Exit + | Global -> + fun _ -> raise Exit let vexpr (type result) (type visit_action) : (unit, result, visit_action) context -> unit -> visit_action = function - | Local -> fun _ -> raise Exit - | Global -> fun _ -> raise Exit + | Local -> + fun _ -> raise Exit + | Global -> + fun _ -> raise Exit module A = struct type nil = Cstr @@ -2589,8 +2823,10 @@ type _ lst = CNil : nil lst | CCons : 'h * 't lst -> ('h -> 't) lst let rec get_var : type stk ret. (stk s, ret) var -> stk lst -> ret = fun n s -> match (n, s) with - | Head, CCons (h, _) -> h - | Tail n', CCons (_, t) -> get_var n' t + | Head, CCons (h, _) -> + h + | Tail n', CCons (_, t) -> + get_var n' t type 'a t = [< `Foo | `Bar] as 'a @@ -2637,9 +2873,7 @@ let get1 (Cons (x, _) : (_ * 'a, 'a) t) = x (* warn, cf PR#6993 *) -let get1' = function - | (Cons (x, _) : (_ * 'a, 'a) t) -> x - | Nil -> assert false +let get1' = function (Cons (x, _) : (_ * 'a, 'a) t) -> x | Nil -> assert false (* ok *) type _ t = @@ -2732,8 +2966,10 @@ type _ nat = NZ : zero nat | NS : 'a nat -> 'a succ nat type _ fin = FZ : 'a succ fin | FS : 'a fin -> 'a succ fin -(* We cannot define val empty : zero fin -> 'a because we cannot write an - empty pattern matching. This might be useful to have *) +(* We cannot define + val empty : zero fin -> 'a + because we cannot write an empty pattern matching. + This might be useful to have *) (* In place, prove that the parameter is 'a succ *) type _ is_succ = IS : 'a succ is_succ @@ -2749,22 +2985,28 @@ let var x = Var x let lift r : 'm fin -> 'n term = fun x -> Var (r x) let rec pre_subst f = function - | Var x -> f x - | Leaf -> Leaf - | Fork (t1, t2) -> Fork (pre_subst f t1, pre_subst f t2) + | Var x -> + f x + | Leaf -> + Leaf + | Fork (t1, t2) -> + Fork (pre_subst f t1, pre_subst f t2) let comp_subst f g (x : 'a fin) = pre_subst f (g x) -(* val comp_subst : ('b fin -> 'c term) -> ('a fin -> 'b term) -> 'a fin -> - 'c term *) +(* val comp_subst : + ('b fin -> 'c term) -> ('a fin -> 'b term) -> 'a fin -> 'c term *) (* 4 The Occur-Check, through thick and thin *) let rec thin : type n. n succ fin -> n fin -> n succ fin = fun x y -> match (x, y) with - | FZ, y -> FS y - | FS x, FZ -> FZ - | FS x, FS y -> FS (thin x y) + | FZ, y -> + FS y + | FS x, FZ -> + FZ + | FS x, FS y -> + FS (thin x y) let bind t f = match t with None -> None | Some x -> f x (* val bind : 'a option -> ('a -> 'b option) -> 'b option *) @@ -2772,8 +3014,10 @@ let bind t f = match t with None -> None | Some x -> f x let rec thick : type n. n succ fin -> n succ fin -> n fin option = fun x y -> match (x, y) with - | FZ, FZ -> None - | FZ, FS y -> Some y + | FZ, FZ -> + None + | FZ, FS y -> + Some y | FS x, FZ -> let IS = fin_succ x in Some FZ @@ -2784,8 +3028,10 @@ let rec thick : type n. n succ fin -> n succ fin -> n fin option = let rec check : type n. n succ fin -> n succ term -> n term option = fun x t -> match t with - | Var y -> bind (thick x y) (fun x -> Some (Var x)) - | Leaf -> Some Leaf + | Var y -> + bind (thick x y) (fun x -> Some (Var x)) + | Leaf -> + Some Leaf | Fork (t1, t2) -> bind (check x t1) (fun t1 -> bind (check x t2) (fun t2 -> Some (Fork (t1, t2))) ) @@ -2803,8 +3049,10 @@ type (_, _) alist = | Asnoc : ('m, 'n) alist * 'm term * 'm succ fin -> ('m succ, 'n) alist let rec sub : type m n. (m, n) alist -> m fin -> n term = function - | Anil -> var - | Asnoc (s, t, x) -> comp_subst (sub s) (subst_var x t) + | Anil -> + var + | Asnoc (s, t, x) -> + comp_subst (sub s) (subst_var x t) let rec append : type m n l. (m, n) alist -> (l, m) alist -> (l, n) alist = fun r s -> @@ -2816,32 +3064,35 @@ let asnoc a t' x = EAlist (Asnoc (a, t', x)) (* Extra work: we need sub to work on ealist too, for examples *) let rec weaken_fin : type n. n fin -> n succ fin = function - | FZ -> FZ - | FS x -> FS (weaken_fin x) + | FZ -> + FZ + | FS x -> + FS (weaken_fin x) let weaken_term t = pre_subst (fun x -> Var (weaken_fin x)) t let rec weaken_alist : type m n. (m, n) alist -> (m succ, n succ) alist = function - | Anil -> Anil - | Asnoc (s, t, x) -> Asnoc (weaken_alist s, weaken_term t, weaken_fin x) + | Anil -> + Anil + | Asnoc (s, t, x) -> + Asnoc (weaken_alist s, weaken_term t, weaken_fin x) let rec sub' : type m. m ealist -> m fin -> m term = function - | EAlist Anil -> var + | EAlist Anil -> + var | EAlist (Asnoc (s, t, x)) -> comp_subst (sub' (EAlist (weaken_alist s))) (fun t' -> weaken_term (subst_var x t t')) let subst' d = pre_subst (sub' d) -(* val subst' : 'a ealist -> 'a term -> 'a term *) +(* val subst' : 'a ealist -> 'a term -> 'a term *) (* 6 First-Order Unification *) let flex_flex x y = - match thick x y with - | Some y' -> asnoc Anil (Var y') x - | None -> EAlist Anil + match thick x y with Some y' -> asnoc Anil (Var y') x | None -> EAlist Anil (* val flex_flex : 'a succ fin -> 'a succ fin -> 'a succ ealist *) let flex_rigid x t = bind (check x t) (fun t' -> Some (asnoc Anil t' x)) @@ -2850,10 +3101,14 @@ let flex_rigid x t = bind (check x t) (fun t' -> Some (asnoc Anil t' x)) let rec amgu : type m. m term -> m term -> m ealist -> m ealist option = fun s t acc -> match (s, t, acc) with - | Leaf, Leaf, _ -> Some acc - | Leaf, Fork _, _ -> None - | Fork _, Leaf, _ -> None - | Fork (s1, s2), Fork (t1, t2), _ -> bind (amgu s1 t1 acc) (amgu s2 t2) + | Leaf, Leaf, _ -> + Some acc + | Leaf, Fork _, _ -> + None + | Fork _, Leaf, _ -> + None + | Fork (s1, s2), Fork (t1, t2), _ -> + bind (amgu s1 t1 acc) (amgu s2 t2) | Var x, Var y, EAlist Anil -> let IS = fin_succ x in Some (flex_flex x y) @@ -2926,14 +3181,18 @@ let magic : 'a 'b. 'a -> 'b = type _ t = IntLit : int t | BoolLit : bool t let check : type s. s t * s -> bool = function - | BoolLit, false -> false - | IntLit, 6 -> false + | BoolLit, false -> + false + | IntLit, 6 -> + false type ('a, 'b) pair = {fst: 'a; snd: 'b} let check : type s. (s t, s) pair -> bool = function - | {fst= BoolLit; snd= false} -> false - | {fst= IntLit; snd= 6} -> false + | {fst= BoolLit; snd= false} -> + false + | {fst= IntLit; snd= 6} -> + false module type S = sig type t [@@immediate] @@ -3067,9 +3326,9 @@ let test_bar () = val test_bar : unit -> unit = <fun> |}] -(* Uncomment these to test. Should see substantial speedup! let () = - Printf.printf "No @@immediate: %fs\n" (test test_foo) let () = - Printf.printf "With @@immediate: %fs\n" (test test_bar) *) +(* Uncomment these to test. Should see substantial speedup! +let () = Printf.printf "No @@immediate: %fs\n" (test test_foo) +let () = Printf.printf "With @@immediate: %fs\n" (test test_bar) *) (* INVALID DECLARATIONS *) @@ -3362,8 +3621,10 @@ open Typ let rec to_string : 'a. 'a Typ.typ -> 'a -> string = fun (type s) t x -> match (t : s typ) with - | Int eq -> string_of_int (TypEq.apply eq x) - | String eq -> Printf.sprintf "%S" (TypEq.apply eq x) + | Int eq -> + string_of_int (TypEq.apply eq x) + | String eq -> + Printf.sprintf "%S" (TypEq.apply eq x) | Pair (module P) -> let x1, x2 = TypEq.apply P.eq x in Printf.sprintf "(%s,%s)" (to_string P.t1 x1) (to_string P.t2 x2) @@ -3455,7 +3716,8 @@ end) type var = [`Var of string] let subst_var ~subst : var -> _ = function - | `Var s as x -> ( try Subst.find s subst with Not_found -> x ) + | `Var s as x -> ( + try Subst.find s subst with Not_found -> x ) let free_var : var -> _ = function `Var s -> Names.singleton s @@ -3464,12 +3726,16 @@ let free_var : var -> _ = function `Var s -> Names.singleton s type 'a lambda = [`Var of string | `Abs of string * 'a | `App of 'a * 'a] let free_lambda ~free_rec : _ lambda -> _ = function - | #var as x -> free_var x - | `Abs (s, t) -> Names.remove s (free_rec t) - | `App (t1, t2) -> Names.union (free_rec t1) (free_rec t2) + | #var as x -> + free_var x + | `Abs (s, t) -> + Names.remove s (free_rec t) + | `App (t1, t2) -> + Names.union (free_rec t1) (free_rec t2) let map_lambda ~map_rec : _ lambda -> _ = function - | #var as x -> x + | #var as x -> + x | `Abs (s, t) as l -> let t' = map_rec t in if t == t' then l else `Abs (s, t') @@ -3482,7 +3748,8 @@ let next_id = fun () -> incr current ; !current let subst_lambda ~subst_rec ~free ~subst : _ lambda -> _ = function - | #var as x -> subst_var ~subst x + | #var as x -> + subst_var ~subst x | `Abs (s, t) as l -> let used = free t in let used_expr = @@ -3492,16 +3759,17 @@ let subst_lambda ~subst_rec ~free ~subst : _ lambda -> _ = function if List.exists used_expr ~f:(fun t -> Names.mem s (free t)) then let name = s ^ string_of_int (next_id ()) in `Abs - ( name - , subst_rec ~subst:(Subst.add ~key:s ~data:(`Var name) subst) t ) + (name, subst_rec ~subst:(Subst.add ~key:s ~data:(`Var name) subst) t) else map_lambda ~map_rec:(subst_rec ~subst:(Subst.remove s subst)) l - | `App _ as l -> map_lambda ~map_rec:(subst_rec ~subst) l + | `App _ as l -> + map_lambda ~map_rec:(subst_rec ~subst) l let eval_lambda ~eval_rec ~subst l = match map_lambda ~map_rec:eval_rec l with | `App (`Abs (s, t1), t2) -> eval_rec (subst ~subst:(Subst.add ~key:s ~data:t2 Subst.empty) t1) - | t -> t + | t -> + t (* Specialized versions to use on lambda *) @@ -3521,16 +3789,23 @@ type 'a expr = | `Mult of 'a * 'a ] let free_expr ~free_rec : _ expr -> _ = function - | #var as x -> free_var x - | `Num _ -> Names.empty - | `Add (x, y) -> Names.union (free_rec x) (free_rec y) - | `Neg x -> free_rec x - | `Mult (x, y) -> Names.union (free_rec x) (free_rec y) + | #var as x -> + free_var x + | `Num _ -> + Names.empty + | `Add (x, y) -> + Names.union (free_rec x) (free_rec y) + | `Neg x -> + free_rec x + | `Mult (x, y) -> + Names.union (free_rec x) (free_rec y) (* Here map_expr helps a lot *) let map_expr ~map_rec : _ expr -> _ = function - | #var as x -> x - | `Num _ as x -> x + | #var as x -> + x + | `Num _ as x -> + x | `Add (x, y) as e -> let x' = map_rec x and y' = map_rec y in if x == x' && y == y' then e else `Add (x', y') @@ -3542,15 +3817,21 @@ let map_expr ~map_rec : _ expr -> _ = function if x == x' && y == y' then e else `Mult (x', y') let subst_expr ~subst_rec ~subst : _ expr -> _ = function - | #var as x -> subst_var ~subst x - | #expr as e -> map_expr ~map_rec:(subst_rec ~subst) e + | #var as x -> + subst_var ~subst x + | #expr as e -> + map_expr ~map_rec:(subst_rec ~subst) e let eval_expr ~eval_rec e = match map_expr ~map_rec:eval_rec e with - | `Add (`Num m, `Num n) -> `Num (m + n) - | `Neg (`Num n) -> `Num (-n) - | `Mult (`Num m, `Num n) -> `Num (m * n) - | #expr as e -> e + | `Add (`Num m, `Num n) -> + `Num (m + n) + | `Neg (`Num n) -> + `Num (-n) + | `Mult (`Num m, `Num n) -> + `Num (m * n) + | #expr as e -> + e (* Specialized versions *) @@ -3572,34 +3853,45 @@ type lexpr = | `Mult of lexpr * lexpr ] let rec free : lexpr -> _ = function - | #lambda as x -> free_lambda ~free_rec:free x - | #expr as x -> free_expr ~free_rec:free x + | #lambda as x -> + free_lambda ~free_rec:free x + | #expr as x -> + free_expr ~free_rec:free x let rec subst ~subst:s : lexpr -> _ = function - | #lambda as x -> subst_lambda ~subst_rec:subst ~subst:s ~free x - | #expr as x -> subst_expr ~subst_rec:subst ~subst:s x + | #lambda as x -> + subst_lambda ~subst_rec:subst ~subst:s ~free x + | #expr as x -> + subst_expr ~subst_rec:subst ~subst:s x let rec eval : lexpr -> _ = function - | #lambda as x -> eval_lambda ~eval_rec:eval ~subst x - | #expr as x -> eval_expr ~eval_rec:eval x + | #lambda as x -> + eval_lambda ~eval_rec:eval ~subst x + | #expr as x -> + eval_expr ~eval_rec:eval x let rec print = function - | `Var id -> print_string id + | `Var id -> + print_string id | `Abs (id, l) -> print_string (" " ^ id ^ " . ") ; print l - | `App (l1, l2) -> print l1 ; print_string " " ; print l2 - | `Num x -> print_int x - | `Add (e1, e2) -> print e1 ; print_string " + " ; print e2 - | `Neg e -> print_string "-" ; print e - | `Mult (e1, e2) -> print e1 ; print_string " * " ; print e2 + | `App (l1, l2) -> + print l1 ; print_string " " ; print l2 + | `Num x -> + print_int x + | `Add (e1, e2) -> + print e1 ; print_string " + " ; print e2 + | `Neg e -> + print_string "-" ; print e + | `Mult (e1, e2) -> + print e1 ; print_string " * " ; print e2 let () = let e1 = eval1 (`App (`Abs ("x", `Var "x"), `Var "y")) in let e2 = eval2 (`Add (`Mult (`Num 3, `Neg (`Num 2)), `Var "x")) in let e3 = - eval - (`Add (`App (`Abs ("x", `Mult (`Var "x", `Var "x")), `Num 2), `Num 5)) + eval (`Add (`App (`Abs ("x", `Mult (`Var "x", `Var "x")), `Num 2), `Num 5)) in print e1 ; print_newline () ; @@ -3652,8 +3944,7 @@ class ['a] var_ops = object (self : ('a, var) #ops) constraint 'a = [> var] - method subst ~sub (`Var s as x) = - try Subst.find s sub with Not_found -> x + method subst ~sub (`Var s as x) = try Subst.find s sub with Not_found -> x method free (`Var s) = Names.singleton s @@ -3678,13 +3969,17 @@ class ['a] lambda_ops (ops : ('a, 'a) #ops Lazy.t) = method free = function - | #var as x -> var#free x - | `Abs (s, t) -> Names.remove s (!!free t) - | `App (t1, t2) -> Names.union (!!free t1) (!!free t2) + | #var as x -> + var#free x + | `Abs (s, t) -> + Names.remove s (!!free t) + | `App (t1, t2) -> + Names.union (!!free t1) (!!free t2) method map ~f = function - | #var as x -> x + | #var as x -> + x | `Abs (s, t) as l -> let t' = f t in if t == t' then l else `Abs (s, t') @@ -3694,7 +3989,8 @@ class ['a] lambda_ops (ops : ('a, 'a) #ops Lazy.t) = method subst ~sub = function - | #var as x -> var#subst ~sub x + | #var as x -> + var#subst ~sub x | `Abs (s, t) as l -> let used = !!free t in let used_expr = @@ -3703,16 +3999,17 @@ class ['a] lambda_ops (ops : ('a, 'a) #ops Lazy.t) = in if List.exists used_expr ~f:(fun t -> Names.mem s (!!free t)) then let name = s ^ string_of_int (next_id ()) in - `Abs - (name, !!subst ~sub:(Subst.add ~key:s ~data:(`Var name) sub) t) + `Abs (name, !!subst ~sub:(Subst.add ~key:s ~data:(`Var name) sub) t) else self#map ~f:(!!subst ~sub:(Subst.remove s sub)) l - | `App _ as l -> self#map ~f:(!!subst ~sub) l + | `App _ as l -> + self#map ~f:(!!subst ~sub) l method eval l = match self#map ~f:!!eval l with | `App (`Abs (s, t1), t2) -> !!eval (!!subst ~sub:(Subst.add ~key:s ~data:t2 Subst.empty) t1) - | t -> t + | t -> + t end (* Operations specialized to lambda *) @@ -3738,16 +4035,23 @@ class ['a] expr_ops (ops : ('a, 'a) #ops Lazy.t) = method free = function - | #var as x -> var#free x - | `Num _ -> Names.empty - | `Add (x, y) -> Names.union (!!free x) (!!free y) - | `Neg x -> !!free x - | `Mult (x, y) -> Names.union (!!free x) (!!free y) + | #var as x -> + var#free x + | `Num _ -> + Names.empty + | `Add (x, y) -> + Names.union (!!free x) (!!free y) + | `Neg x -> + !!free x + | `Mult (x, y) -> + Names.union (!!free x) (!!free y) method map ~f = function - | #var as x -> x - | `Num _ as x -> x + | #var as x -> + x + | `Num _ as x -> + x | `Add (x, y) as e -> let x' = f x and y' = f y in if x == x' && y == y' then e else `Add (x', y') @@ -3760,15 +4064,21 @@ class ['a] expr_ops (ops : ('a, 'a) #ops Lazy.t) = method subst ~sub = function - | #var as x -> var#subst ~sub x - | #expr as e -> self#map ~f:(!!subst ~sub) e + | #var as x -> + var#subst ~sub x + | #expr as e -> + self#map ~f:(!!subst ~sub) e method eval (#expr as e) = match self#map ~f:!!eval e with - | `Add (`Num m, `Num n) -> `Num (m + n) - | `Neg (`Num n) -> `Num (-n) - | `Mult (`Num m, `Num n) -> `Num (m * n) - | e -> e + | `Add (`Num m, `Num n) -> + `Num (m + n) + | `Neg (`Num n) -> + `Num (-n) + | `Mult (`Num m, `Num n) -> + `Num (m * n) + | e -> + e end (* Specialized versions *) @@ -3790,8 +4100,10 @@ class ['a] lexpr_ops (ops : ('a, 'a) #ops Lazy.t) = method subst ~sub = function - | #lambda as x -> lambda#subst ~sub x - | #expr as x -> expr#subst ~sub x + | #lambda as x -> + lambda#subst ~sub x + | #expr as x -> + expr#subst ~sub x method eval = function #lambda as x -> lambda#eval x | #expr as x -> expr#eval x @@ -3800,15 +4112,21 @@ class ['a] lexpr_ops (ops : ('a, 'a) #ops Lazy.t) = let lexpr = lazy_fix (new lexpr_ops) let rec print = function - | `Var id -> print_string id + | `Var id -> + print_string id | `Abs (id, l) -> print_string (" " ^ id ^ " . ") ; print l - | `App (l1, l2) -> print l1 ; print_string " " ; print l2 - | `Num x -> print_int x - | `Add (e1, e2) -> print e1 ; print_string " + " ; print e2 - | `Neg e -> print_string "-" ; print e - | `Mult (e1, e2) -> print e1 ; print_string " * " ; print e2 + | `App (l1, l2) -> + print l1 ; print_string " " ; print l2 + | `Num x -> + print_int x + | `Add (e1, e2) -> + print e1 ; print_string " + " ; print e2 + | `Neg e -> + print_string "-" ; print e + | `Mult (e1, e2) -> + print e1 ; print_string " * " ; print e2 let () = let e1 = lambda#eval (`App (`Abs ("x", `Var "x"), `Var "y")) in @@ -3866,8 +4184,7 @@ type var = [`Var of string] let var = object (self : ([> var], var) #ops) - method subst ~sub (`Var s as x) = - try Subst.find s sub with Not_found -> x + method subst ~sub (`Var s as x) = try Subst.find s sub with Not_found -> x method free (`Var s) = Names.singleton s @@ -3889,13 +4206,17 @@ let lambda_ops (ops : ('a, 'a) #ops Lazy.t) = object (self : ([> 'a lambda], 'a lambda) #ops) method free = function - | #var as x -> var#free x - | `Abs (s, t) -> Names.remove s (!!free t) - | `App (t1, t2) -> Names.union (!!free t1) (!!free t2) + | #var as x -> + var#free x + | `Abs (s, t) -> + Names.remove s (!!free t) + | `App (t1, t2) -> + Names.union (!!free t1) (!!free t2) method private map ~f = function - | #var as x -> x + | #var as x -> + x | `Abs (s, t) as l -> let t' = f t in if t == t' then l else `Abs (s, t') @@ -3905,7 +4226,8 @@ let lambda_ops (ops : ('a, 'a) #ops Lazy.t) = method subst ~sub = function - | #var as x -> var#subst ~sub x + | #var as x -> + var#subst ~sub x | `Abs (s, t) as l -> let used = !!free t in let used_expr = @@ -3914,16 +4236,17 @@ let lambda_ops (ops : ('a, 'a) #ops Lazy.t) = in if List.exists used_expr ~f:(fun t -> Names.mem s (!!free t)) then let name = s ^ string_of_int (next_id ()) in - `Abs - (name, !!subst ~sub:(Subst.add ~key:s ~data:(`Var name) sub) t) + `Abs (name, !!subst ~sub:(Subst.add ~key:s ~data:(`Var name) sub) t) else self#map ~f:(!!subst ~sub:(Subst.remove s sub)) l - | `App _ as l -> self#map ~f:(!!subst ~sub) l + | `App _ as l -> + self#map ~f:(!!subst ~sub) l method eval l = match self#map ~f:!!eval l with | `App (`Abs (s, t1), t2) -> !!eval (!!subst ~sub:(Subst.add ~key:s ~data:t2 Subst.empty) t1) - | t -> t + | t -> + t end (* Operations specialized to lambda *) @@ -3946,16 +4269,23 @@ let expr_ops (ops : ('a, 'a) #ops Lazy.t) = object (self : ([> 'a expr], 'a expr) #ops) method free = function - | #var as x -> var#free x - | `Num _ -> Names.empty - | `Add (x, y) -> Names.union (!!free x) (!!free y) - | `Neg x -> !!free x - | `Mult (x, y) -> Names.union (!!free x) (!!free y) + | #var as x -> + var#free x + | `Num _ -> + Names.empty + | `Add (x, y) -> + Names.union (!!free x) (!!free y) + | `Neg x -> + !!free x + | `Mult (x, y) -> + Names.union (!!free x) (!!free y) method private map ~f = function - | #var as x -> x - | `Num _ as x -> x + | #var as x -> + x + | `Num _ as x -> + x | `Add (x, y) as e -> let x' = f x and y' = f y in if x == x' && y == y' then e else `Add (x', y') @@ -3968,15 +4298,21 @@ let expr_ops (ops : ('a, 'a) #ops Lazy.t) = method subst ~sub = function - | #var as x -> var#subst ~sub x - | #expr as e -> self#map ~f:(!!subst ~sub) e + | #var as x -> + var#subst ~sub x + | #expr as e -> + self#map ~f:(!!subst ~sub) e method eval (#expr as e) = match self#map ~f:!!eval e with - | `Add (`Num m, `Num n) -> `Num (m + n) - | `Neg (`Num n) -> `Num (-n) - | `Mult (`Num m, `Num n) -> `Num (m * n) - | e -> e + | `Add (`Num m, `Num n) -> + `Num (m + n) + | `Neg (`Num n) -> + `Num (-n) + | `Mult (`Num m, `Num n) -> + `Num (m * n) + | e -> + e end (* Specialized versions *) @@ -3996,8 +4332,10 @@ let lexpr_ops (ops : ('a, 'a) #ops Lazy.t) = method subst ~sub = function - | #lambda as x -> lambda#subst ~sub x - | #expr as x -> expr#subst ~sub x + | #lambda as x -> + lambda#subst ~sub x + | #expr as x -> + expr#subst ~sub x method eval = function #lambda as x -> lambda#eval x | #expr as x -> expr#eval x @@ -4006,15 +4344,21 @@ let lexpr_ops (ops : ('a, 'a) #ops Lazy.t) = let lexpr = lazy_fix lexpr_ops let rec print = function - | `Var id -> print_string id + | `Var id -> + print_string id | `Abs (id, l) -> print_string (" " ^ id ^ " . ") ; print l - | `App (l1, l2) -> print l1 ; print_string " " ; print l2 - | `Num x -> print_int x - | `Add (e1, e2) -> print e1 ; print_string " + " ; print e2 - | `Neg e -> print_string "-" ; print e - | `Mult (e1, e2) -> print e1 ; print_string " * " ; print e2 + | `App (l1, l2) -> + print l1 ; print_string " " ; print l2 + | `Num x -> + print_int x + | `Add (e1, e2) -> + print e1 ; print_string " + " ; print e2 + | `Neg e -> + print_string "-" ; print e + | `Mult (e1, e2) -> + print e1 ; print_string " * " ; print e2 let () = let e1 = lambda#eval (`App (`Abs ("x", `Var "x"), `Var "y")) in @@ -4081,11 +4425,9 @@ module Permissioned : sig type ('a, -'perms) t include sig - val t_of_sexp : - (sexp -> 'a) -> (sexp -> 'perms) -> sexp -> ('a, 'perms) t + val t_of_sexp : (sexp -> 'a) -> (sexp -> 'perms) -> sexp -> ('a, 'perms) t - val sexp_of_t : - ('a -> sexp) -> ('perms -> sexp) -> ('a, 'perms) t -> sexp + val sexp_of_t : ('a -> sexp) -> ('perms -> sexp) -> ('a, 'perms) t -> sexp end module Int : sig @@ -4378,17 +4720,22 @@ module M' : module type of Std'.M = Std2.M let f3 (x : M'.t) = (x : Std2.M.t) -(* original report required Core_kernel: module type S = sig open - Core_kernel.Std +(* original report required Core_kernel: +module type S = sig +open Core_kernel.Std - module Hashtbl1 : module type of Hashtbl module Hashtbl2 : sig include - (module type of Hashtbl) end +module Hashtbl1 : module type of Hashtbl +module Hashtbl2 : sig + include (module type of Hashtbl) +end - module Coverage : Core_kernel.Std.Hashable +module Coverage : Core_kernel.Std.Hashable - type types = unit constraint 'a Coverage.Table.t = (Coverage.t, 'a) - Hashtbl1.t type doesnt_type = unit constraint 'a Coverage.Table.t = - (Coverage.t, 'a) Hashtbl2.t end *) +type types = unit constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl1.t +type doesnt_type = unit + constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl2.t +end +*) module type INCLUDING = sig include module type of List @@ -4561,12 +4908,22 @@ module type PR6513 = sig S with type u = < foo: Html5.uri > end -(* Requires -package tyxml module type PR6513_orig = sig module type S = sig - type t type u end +(* Requires -package tyxml +module type PR6513_orig = sig +module type S = +sig + type t + type u +end - module Make: functor (Html5: Html5_sigs.T with type 'a Xml.wrap = 'a and - type 'a wrap = 'a and type 'a list_wrap = 'a list) -> S with type t = - Html5_types.div Html5.elt and type u = < foo: Html5.uri > end *) +module Make: functor (Html5: Html5_sigs.T + with type 'a Xml.wrap = 'a and + type 'a wrap = 'a and + type 'a list_wrap = 'a list) + -> S with type t = Html5_types.div Html5.elt and + type u = < foo: Html5.uri > +end +*) module type S = sig include Set.S @@ -4652,9 +5009,12 @@ module M1 = struct type Common.msg += Reload of string | Alert of string let handle fallback = function - | Reload s -> print_endline ("Reload " ^ s) - | Alert s -> print_endline ("Alert " ^ s) - | x -> fallback x + | Reload s -> + print_endline ("Reload " ^ s) + | Alert s -> + print_endline ("Alert " ^ s) + | x -> + fallback x let () = Common.extend_handle handle @@ -4694,7 +5054,7 @@ module X = struct end end -(* open X (* works! *) *) +(* open X (* works! *) *) module Y = X.Y type 'a arg_t = 'at constraint 'a = (module Y.S with type t = 'at) @@ -4734,8 +5094,7 @@ module A_annotated_alias : S with type t = (module A.A_S) = A let _ = f (module A_annotated_alias) (* ok *) -let _ = f (module A_annotated_alias : S with type t = (module A.A_S)) -(* ok *) +let _ = f (module A_annotated_alias : S with type t = (module A.A_S)) (* ok *) module A_alias = A @@ -4747,8 +5106,7 @@ let _ = f (module A_alias_expanded : S with type t = (module A.A_S)) (* ok *) let _ = f (module A_alias_expanded) (* ok *) -let _ = f (module A_alias : S with type t = (module A.A_S)) -(* doesn't type *) +let _ = f (module A_alias : S with type t = (module A.A_S)) (* doesn't type *) let _ = f (module A_alias) (* doesn't type either *) @@ -4779,9 +5137,11 @@ struct let uniq (type a) (type b) (Eq : a fix) (Eq : b fix) : (a, b) eq = Eq end -(* This would allow: module FixId = Fix (struct type 'a f = 'a end) let bad : - (int, string) eq = FixId.uniq Eq Eq let _ = Printf.printf "Oh dear: %s" - (cast bad 42) *) +(* This would allow: +module FixId = Fix (struct type 'a f = 'a end) + let bad : (int, string) eq = FixId.uniq Eq Eq + let _ = Printf.printf "Oh dear: %s" (cast bad 42) +*) module M = struct module type S = sig type a @@ -5372,7 +5732,8 @@ struct end module G = F (M.Y) -(*module N = G (M);; module N = F (M.Y) (M);;*) +(*module N = G (M);; +module N = F (M.Y) (M);;*) (* PR#6307 *) @@ -5434,15 +5795,18 @@ end (* fail *) -(* (* if the above succeeded, one could break invariants *) module rec M2 : - S' = M2;; (* should succeed! (but this is bad) *) +(* (* if the above succeeded, one could break invariants *) +module rec M2 : S' = M2;; (* should succeed! (but this is bad) *) - let M2.W eq = W Eq;; +let M2.W eq = W Eq;; - let s = List.fold_right SInt.add [1;2;3] SInt.empty;; module SInt2 = - Set.Make(Int2);; let conv : type a b. (a,b) eq -> a -> b = fun Eq x -> x;; - let s' : SInt2.t = conv eq s;; SInt2.elements s';; SInt2.mem 2 s';; (* - invariants are broken *) *) +let s = List.fold_right SInt.add [1;2;3] SInt.empty;; +module SInt2 = Set.Make(Int2);; +let conv : type a b. (a,b) eq -> a -> b = fun Eq x -> x;; +let s' : SInt2.t = conv eq s;; +SInt2.elements s';; +SInt2.mem 2 s';; (* invariants are broken *) +*) (* Check behavior with submodules *) module M = struct @@ -5628,12 +5992,16 @@ end = struct include A end -(* The following introduces a (useless) dependency on A: module C : sig - module L : module type of List end = A *) +(* The following introduces a (useless) dependency on A: +module C : sig module L : module type of List end = A +*) include D' -(* let () = print_endline (string_of_int D'.M.y) *) +(* +let () = + print_endline (string_of_int D'.M.y) +*) open A let f = L.map S.capitalize @@ -5646,8 +6014,9 @@ end = struct include A end -(* The following introduces a (useless) dependency on A: module C : sig - module L : module type of List end = A *) +(* The following introduces a (useless) dependency on A: +module C : sig module L : module type of List end = A +*) (* No dependency on D *) let x = 3 @@ -5668,8 +6037,8 @@ module type S' = sig type u = bool end -(* ok to convert between structurally equal signatures, and parameters are - inferred *) +(* ok to convert between structurally equal signatures, and parameters + are inferred *) let f (x : (module S with type t = 'a and type u = 'b)) = (x : (module S')) let g x = (x : (module S with type t = 'a and type u = 'b) :> (module S')) @@ -5804,8 +6173,10 @@ class app e1 e2 : exp = method eval env = match l with - | `Abs (var, body) -> Hashtbl.add env var r ; body - | _ -> `App (l, r) + | `Abs (var, body) -> + Hashtbl.add env var r ; body + | _ -> + `App (l, r) end class virtual ['subject, 'event] observer = @@ -6029,8 +6400,7 @@ module UChar = struct let lower_bits = highest_bit - 1 - let char_of c = - try Char.chr c with Invalid_argument _ -> raise Out_of_range + let char_of c = try Char.chr c with Invalid_argument _ -> raise Out_of_range let of_char = Char.code @@ -6102,8 +6472,7 @@ module UText = struct method copy = {<contents = String.copy contents>} - method sub pos len = - {<contents = String.sub contents (pos * 4) (len * 4)>} + method sub pos len = {<contents = String.sub contents (pos * 4) (len * 4)>} method concat (text : ustorage) = let buf = String.create (String.length contents + (4 * text#len)) in @@ -6209,7 +6578,8 @@ and func (args_ty, ret_ty) = method arguments = match memo_args with - | Some xs -> xs + | Some xs -> + xs | None -> let args = List.map (fun ty -> new argument (self, ty)) args_ty in memo_args <- Some args ; @@ -6296,8 +6666,11 @@ module M : sig end = struct type refer = {poly: 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a)} end -(* ocamlc -c pr3918a.mli pr3918b.mli rm -f pr3918a.cmi ocamlc -c - pr3918c.ml *) +(* + ocamlc -c pr3918a.mli pr3918b.mli + rm -f pr3918a.cmi + ocamlc -c pr3918c.ml +*) open Pr3918b @@ -6405,21 +6778,32 @@ module Fpc (X : T with type term = private [> 'a termpc] as 'a) = struct type term = X.term termpc let nnf = function - | `Not (`Atom _) as x -> x - | `Not x -> X.nnf_not x - | x -> X.map X.nnf x + | `Not (`Atom _) as x -> + x + | `Not x -> + X.nnf_not x + | x -> + X.map X.nnf x let map f : term -> X.term = function - | `Not x -> `Not (f x) - | `And (x, y) -> `And (f x, f y) - | `Or (x, y) -> `Or (f x, f y) - | `Atom _ as x -> x + | `Not x -> + `Not (f x) + | `And (x, y) -> + `And (f x, f y) + | `Or (x, y) -> + `Or (f x, f y) + | `Atom _ as x -> + x let nnf_not : term -> _ = function - | `Not x -> X.nnf x - | `And (x, y) -> `Or (X.nnf_not x, X.nnf_not y) - | `Or (x, y) -> `And (X.nnf_not x, X.nnf_not y) - | `Atom _ as x -> `Not x + | `Not x -> + X.nnf x + | `And (x, y) -> + `Or (X.nnf_not x, X.nnf_not y) + | `Or (x, y) -> + `And (X.nnf_not x, X.nnf_not y) + | `Atom _ as x -> + `Not x end module Fk (X : T with type term = private [> 'a termk] as 'a) = struct @@ -6428,16 +6812,22 @@ module Fk (X : T with type term = private [> 'a termk] as 'a) = struct module Pc = Fpc (X) let map f : term -> _ = function - | `Dia x -> `Dia (f x) - | `Box x -> `Box (f x) - | #termpc as x -> Pc.map f x + | `Dia x -> + `Dia (f x) + | `Box x -> + `Box (f x) + | #termpc as x -> + Pc.map f x let nnf = Pc.nnf let nnf_not : term -> _ = function - | `Dia x -> `Box (X.nnf_not x) - | `Box x -> `Dia (X.nnf_not x) - | #termpc as x -> Pc.nnf_not x + | `Dia x -> + `Box (X.nnf_not x) + | `Box x -> + `Dia (X.nnf_not x) + | #termpc as x -> + Pc.nnf_not x end type untyped @@ -6669,8 +7059,8 @@ let f Test2.A = () let a = Test2.A (* fail *) -(* The following should fail from a semantical point of view, but allow it - for backward compatibility *) +(* The following should fail from a semantical point of view, + but allow it for backward compatibility *) module Test2 : module type of Test with type t = private Test.t = Test (* PR#6331 *) @@ -6910,8 +7300,8 @@ module PR_4450_2 = struct end end -(* A synthetic example of bootstrapped data structure (suggested by J-C - Filliatre) *) +(* A synthetic example of bootstrapped data structure + (suggested by J-C Filliatre) *) module type ORD = sig type t @@ -6952,11 +7342,11 @@ module Bootstrap2 for i = l to r do f i done - | D (_, d, _) -> Diet.iter (iter f) d + | D (_, d, _) -> + Diet.iter (iter f) d end - and Diet : (SET with type t = Elt.t tree and type elt = Elt.t) = - MakeDiet (Elt) + and Diet : (SET with type t = Elt.t tree and type elt = Elt.t) = MakeDiet (Elt) type t = Diet.t @@ -7093,10 +7483,14 @@ end = struct let compare x y = match (x, y) with - | Leaf i, Leaf j -> Pervasives.compare i j - | Leaf i, Node t -> -1 - | Node s, Leaf j -> 1 - | Node s, Node t -> ASet.compare s t + | Leaf i, Leaf j -> + Pervasives.compare i j + | Leaf i, Node t -> + -1 + | Node s, Leaf j -> + 1 + | Node s, Node t -> + ASet.compare s t end and ASet : (Set.S with type elt = A.t) = Set.Make (A) @@ -7153,8 +7547,12 @@ let _ = (* Early strict evaluation *) -(* module rec Cyclic : sig val x : int end = struct let x = Cyclic.x + 1 end - ;; *) +(* +module rec Cyclic + : sig val x : int end + = struct let x = Cyclic.x + 1 end +;; +*) (* Reordering of evaluation based on dependencies *) @@ -7234,23 +7632,29 @@ end = struct let x = (PolyRec.Leaf 1 : int t) let depth = function - | Leaf x -> 0 - | Node (l, r) -> 1 + max (PolyRec.depth l) (PolyRec.depth r) + | Leaf x -> + 0 + | Node (l, r) -> + 1 + max (PolyRec.depth l) (PolyRec.depth r) end (* Wrong LHS signatures (PR#4336) *) -(* module type ASig = sig type a val a:a val print:a -> unit end module type - BSig = sig type b val b:b val print:b -> unit end +(* +module type ASig = sig type a val a:a val print:a -> unit end +module type BSig = sig type b val b:b val print:b -> unit end - module A = struct type a = int let a = 0 let print = print_int end module - B = struct type b = float let b = 0.0 let print = print_float end +module A = struct type a = int let a = 0 let print = print_int end +module B = struct type b = float let b = 0.0 let print = print_float end - module MakeA (Empty:sig end) : ASig = A module MakeB (Empty:sig end) : - BSig = B +module MakeA (Empty:sig end) : ASig = A +module MakeB (Empty:sig end) : BSig = B - module rec NewA : ASig = MakeA (struct end) and NewB : BSig with type b = - NewA.a = MakeB (struct end);; *) +module + rec NewA : ASig = MakeA (struct end) + and NewB : BSig with type b = NewA.a = MakeB (struct end);; + +*) (* Expressions and bindings *) @@ -7278,20 +7682,30 @@ end = struct let make_let id e1 e2 = Binding ([(id, e1)], e2) let rec fv = function - | Var s -> StringSet.singleton s - | Const n -> StringSet.empty - | Add (t1, t2) -> StringSet.union (fv t1) (fv t2) + | Var s -> + StringSet.singleton s + | Const n -> + StringSet.empty + | Add (t1, t2) -> + StringSet.union (fv t1) (fv t2) | Binding (b, t) -> StringSet.union (Binding.fv b) (StringSet.diff (fv t) (Binding.bv b)) let rec simpl = function - | Var s -> Var s - | Const n -> Const n - | Add (Const i, Const j) -> Const (i + j) - | Add (Const 0, t) -> simpl t - | Add (t, Const 0) -> simpl t - | Add (t1, t2) -> Add (simpl t1, simpl t2) - | Binding (b, t) -> Binding (Binding.simpl b, simpl t) + | Var s -> + Var s + | Const n -> + Const n + | Add (Const i, Const j) -> + Const (i + j) + | Add (Const 0, t) -> + simpl t + | Add (t, Const 0) -> + simpl t + | Add (t1, t2) -> + Add (simpl t1, simpl t2) + | Binding (b, t) -> + Binding (Binding.simpl b, simpl t) end and Binding : sig @@ -7372,24 +7786,36 @@ module Bootstrap let leq t1 t2 = match (t1, t2) with - | H (x, _), H (y, _) -> Elem.leq x y - | H _, E -> false - | E, H _ -> true - | E, E -> true + | H (x, _), H (y, _) -> + Elem.leq x y + | H _, E -> + false + | E, H _ -> + true + | E, E -> + true let eq t1 t2 = match (t1, t2) with - | H (x, _), H (y, _) -> Elem.eq x y - | H _, E -> false - | E, H _ -> false - | E, E -> true + | H (x, _), H (y, _) -> + Elem.eq x y + | H _, E -> + false + | E, H _ -> + false + | E, E -> + true let lt t1 t2 = match (t1, t2) with - | H (x, _), H (y, _) -> Elem.lt x y - | H _, E -> false - | E, H _ -> true - | E, E -> false + | H (x, _), H (y, _) -> + Elem.lt x y + | H _, E -> + false + | E, H _ -> + true + | E, E -> + false end and PrimH : (HEAP with type Elem.t = BE.t) = MakeH (BE) @@ -7402,8 +7828,10 @@ module Bootstrap let rec merge x y = match (x, y) with - | BE.E, _ -> y - | _, BE.E -> x + | BE.E, _ -> + y + | _, BE.E -> + x | (BE.H (e1, p1) as h1), (BE.H (e2, p2) as h2) -> if Elem.leq e1 e2 then BE.H (e1, PrimH.insert h2 p1) else BE.H (e2, PrimH.insert h1 p2) @@ -7413,7 +7841,8 @@ module Bootstrap let findMin = function BE.E -> raise Not_found | BE.H (x, _) -> x let deleteMin = function - | BE.E -> raise Not_found + | BE.E -> + raise Not_found | BE.H (x, p) -> ( if PrimH.isEmpty p then BE.E else @@ -7421,7 +7850,8 @@ module Bootstrap | BE.H (y, p1) -> let p2 = PrimH.deleteMin p in BE.H (y, PrimH.merge p1 p2) - | BE.E -> assert false ) + | BE.E -> + assert false ) end module LeftistHeap (Element : ORDERED) : HEAP with module Elem = Element = @@ -7433,8 +7863,7 @@ struct let rank = function E -> 0 | T (r, _, _, _) -> r let make x a b = - if rank a >= rank b then T (rank b + 1, x, a, b) - else T (rank a + 1, x, b, a) + if rank a >= rank b then T (rank b + 1, x, a, b) else T (rank a + 1, x, b, a) let empty = E @@ -7442,8 +7871,10 @@ struct let rec merge h1 h2 = match (h1, h2) with - | _, E -> h1 - | E, _ -> h2 + | _, E -> + h1 + | E, _ -> + h2 | T (_, x1, a1, b1), T (_, x2, a2, b2) -> if Elem.leq x1 x2 then make x1 a1 (merge b1 h2) else make x2 a2 (merge h1 b2) @@ -7452,9 +7883,7 @@ struct let findMin = function E -> raise Not_found | T (_, x, _, _) -> x - let deleteMin = function - | E -> raise Not_found - | T (_, x, a, b) -> merge a b + let deleteMin = function E -> raise Not_found | T (_, x, a, b) -> merge a b end module Ints = struct @@ -7638,7 +8067,7 @@ end = let _ = test 103 (Lazy.force M3.x) 3 -(** Pure type-checking tests: see recmod/*.ml *) +(** Pure type-checking tests: see recmod/*.ml *) type t = A of {x: int; mutable y: int} let f (A r) = r @@ -7781,8 +8210,7 @@ let h (x : int) : bool = M.g (M.f x) type _ t = C : ((('a -> 'o) -> 'o) -> ('b -> 'o) -> 'o) t -let f : type a o. ((a -> o) -> o) t -> (a -> o) -> o = - fun C k -> k (fun x -> x) +let f : type a o. ((a -> o) -> o) t -> (a -> o) -> o = fun C k -> k (fun x -> x) module type T = sig type 'a t @@ -7932,8 +8360,8 @@ module M2 = struct type v = A.B.t end -(* Adapted from: An Expressive Language of Signatures by Norman Ramsey, - Kathleen Fisher and Paul Govereau *) +(* Adapted from: An Expressive Language of Signatures + by Norman Ramsey, Kathleen Fisher and Paul Govereau *) module type VALUE = sig type value (* a Lua value *) @@ -8314,8 +8742,8 @@ external i : (int -> float[@unboxed]) = "i" "i_nat" (* Bad: unboxing a "deep" sub-type. *) external j : int -> (float[@unboxed]) * float = "j" "j_nat" -(* This should be rejected, but it is quite complicated to do in the current - state of things *) +(* This should be rejected, but it is quite complicated to do + in the current state of things *) external k : int -> (float[@unboxd]) = "k" "k_nat" @@ -8398,8 +8826,10 @@ let f : type a b c d e f g. * (a, b, c, d) u * (e, f, g, g) u -> int = function - | A, A, A, A, A, A, A, _, U, U -> 1 - | _, _, _, _, _, _, _, G, _, _ -> 1 + | A, A, A, A, A, A, A, _, U, U -> + 1 + | _, _, _, _, _, _, _, G, _, _ -> + 1 (*| _ -> _ *) (* Unused cases *) @@ -8468,17 +8898,22 @@ type (_, _, _) plus = | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus let trivial : (zero succ, zero, zero) plus option -> bool = function - | None -> false + | None -> + false let easy : (zero, zero succ, zero) plus option -> bool = function - | None -> false + | None -> + false let harder : (zero succ, zero succ, zero succ) plus option -> bool = function - | None -> false + | None -> + false let harder : (zero succ, zero succ, zero succ) plus option -> bool = function - | None -> false - | Some (PlusS _) -> . + | None -> + false + | Some (PlusS _) -> + . let inv_zero : type a b c d. (a, b, c) plus -> (c, d, zero) plus -> bool = fun p1 p2 -> match (p1, p2) with Plus0, Plus0 -> true @@ -8954,15 +9389,22 @@ let f = function (x [@wee]) -> () let f = function '1' .. '9' | '1' .. '8' -> () | 'a' .. 'z' -> () let f = function - | [|x1; x2|] -> () - | [||] -> () - | ([|x|] [@foo]) -> () - | _ -> () + | [|x1; x2|] -> + () + | [||] -> + () + | ([|x|] [@foo]) -> + () + | _ -> + () let g = function - | {l= x} -> () - | ({l1= x; l2= y} [@foo]) -> () - | {l1= x; l2= y; _} -> () + | {l= x} -> + () + | ({l1= x; l2= y} [@foo]) -> + () + | {l1= x; l2= y; _} -> + () let h = fun ?l:(p = 1) ?y:u ?(x = 3) -> 2 @@ -9155,8 +9597,7 @@ let x = A (B).a let formula_base x = let open Formula.Infix in - (Expr.typeof x)#==(Lit (Type IntType))#&&(x#<=(Expr.int 4))#&&( (Expr.int 0) - #<x ) + (Expr.typeof x)#==(Lit (Type IntType))#&&(x#<=(Expr.int 4))#&&((Expr.int 0)#<x) let _ = call ~f:(fun pair -> (pair : a * b)) ;; @@ -9165,7 +9606,8 @@ f | true -> let () = () in () - | false -> () ) + | false -> + () ) () ;; @@ -9175,11 +9617,15 @@ f let () = () in () (* comment *) - | false -> () ) + | false -> + () ) () let xxxxxx = - let%map (* _____________________________ __________ *) () = yyyyyyyy in + let%map (* _____________________________ + __________ *) () = + yyyyyyyy + in {zzzzzzzzzzzzz} let _ = fun (x : int as 'a) -> (x : int as 'a) @@ -9199,14 +9645,17 @@ let eradicate_meta_class_is_nullsafe = (* Should be enabled for special integrations *) ~enabled:false Info -let () = - match () with _ -> ( fun _ : _ -> match () with _ -> () ) | _ -> () +let () = match () with _ -> ( fun _ : _ -> match () with _ -> () ) | _ -> () let f = function - | Foo -> bar + | Foo -> + bar | EArr l -> EArr (List.map l ~f:(function - | ElementHole -> ElementHole - | Element e -> Element (m#expression e) - | ElementSpread e -> ElementSpread (m#expression e) )) + | ElementHole -> + ElementHole + | Element e -> + Element (m#expression e) + | ElementSpread e -> + ElementSpread (m#expression e) )) diff --git a/test/passing/refs.ocamlformat/str_value.ml.ref b/test/passing/refs.ocamlformat/str_value.ml.ref new file mode 100644 index 0000000000..7eb40e2fb1 --- /dev/null +++ b/test/passing/refs.ocamlformat/str_value.ml.ref @@ -0,0 +1,75 @@ +module Compact = struct + [@@@ocamlformat "let-binding-spacing=compact"] + + (* doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + (** doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd + + and f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd + + let f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd +end + +module Nl = struct + [@@@ocamlformat "let-binding-spacing=sparse"] + + (* doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + (** doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd + + + and f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd + + + let f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd +end + +module Double = struct + [@@@ocamlformat "let-binding-spacing=double-semicolon"] + + (* doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + (** doc *) + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + + let f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd + + and f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd + ;; + + let f x = + dddd dddddddddd dddddddddd dddddddddddd ddddddddd dddddddddd + dddddddddddddddddddd dddddddddddd + ;; +end diff --git a/test/passing/tests/string.ml.ref b/test/passing/refs.ocamlformat/string.ml.ref similarity index 92% rename from test/passing/tests/string.ml.ref rename to test/passing/refs.ocamlformat/string.ml.ref index aca6882ba8..4a62841ab7 100644 --- a/test/passing/tests/string.ml.ref +++ b/test/passing/refs.ocamlformat/string.ml.ref @@ -2,8 +2,8 @@ let f = function | () -> raise_s [%sexp - "Xxxx \036 \036 \036 \036 \036 \036 \036 xxx xxxx xx xxxxxx xx \ - xxx xxxxxxx xxxxxx, xxxxxxx xxxxxxxxxx xx xxxx. Xxxx." + "Xxxx \036 \036 \036 \036 \036 \036 \036 xxx xxxx xx xxxxxx xx xxx \ + xxxxxxx xxxxxx, xxxxxxx xxxxxxxxxx xx xxxx. Xxxx." , 0] let _ = "\010\xFFa\o123\n\\\u{12345}aa🐪🐪🐪🐪🐪\n" diff --git a/test/passing/refs.ocamlformat/string_array.ml.ref b/test/passing/refs.ocamlformat/string_array.ml.ref new file mode 100644 index 0000000000..16a79d22d7 --- /dev/null +++ b/test/passing/refs.ocamlformat/string_array.ml.ref @@ -0,0 +1,25 @@ +(f ()).(2) <- e ;; + +(f ()).(2) <- (e, 2) ;; + +((f ()).(2) <- e), 2 ;; + +(f ()).[2] <- e ;; + +(f ()).[2] <- (e, 2) ;; + +((f ()).[2] <- e), 2 ;; + +(f ()).{2} <- e ;; + +(f ()).{2} <- (e, 2) ;; + +((f ()).{2} <- e), 2 ;; + +(f ()).{2, 2, 2, 2} <- e ;; + +(f ()).{2, 2, 2, 2} <- (e, 2) ;; + +((f ()).{2, 2, 2, 2} <- e), 2 + +let l = [|(fun x -> x); (fun y -> y)|] diff --git a/test/passing/refs.ocamlformat/string_wrapping.ml.ref b/test/passing/refs.ocamlformat/string_wrapping.ml.ref new file mode 100644 index 0000000000..862ef631cc --- /dev/null +++ b/test/passing/refs.ocamlformat/string_wrapping.ml.ref @@ -0,0 +1,3 @@ +let universal_declaration = + "-1- Programs are born and remain free and equal under the law;\n\ + distinctions can only be based on the common good." diff --git a/test/passing/refs.ocamlformat/symbol.ml.ref b/test/passing/refs.ocamlformat/symbol.ml.ref new file mode 100644 index 0000000000..d8f8ba33b4 --- /dev/null +++ b/test/passing/refs.ocamlformat/symbol.ml.ref @@ -0,0 +1,27 @@ +let op = if b then ( * ) else ( + ) in +() +;; + +assert ( * ) ;; + +( * ) [@a] ;; + +assert (( * ) [@a]) + +module Array = struct + let ( .!() ) = Array.unsafe_get + + let ( .!()<- ) = Array.unsafe_set +end + +let ( .!() ), ( .!()<- ) = Array.((( .!() ) [@attr]), ( .!()<- )) + +let _ = ( let++ ) [@attr] ;; + +( let++ ) [@attr] + +let ( let++ ), (( and++ ) [@attr]) = X.((( let++ ) [@attr]), ( and++ )) + +let is_empty = function [] -> true | ( :: ) _ -> false + +let is_empty = (( :: ), ( :: ) 1, (Foo) 2) diff --git a/test/passing/refs.ocamlformat/tag_only.ml.ref b/test/passing/refs.ocamlformat/tag_only.ml.ref new file mode 100644 index 0000000000..a5c068faef --- /dev/null +++ b/test/passing/refs.ocamlformat/tag_only.ml.ref @@ -0,0 +1,194 @@ +(** @deprecated *) +open Module + +(** abc + + @deprecated *) +open Module + +(** @author A *) +open Module + +(** @inline *) +open Module + +(** @inline *) +include Abc + +(** @inline *) +include struct + type t +end + +(** @inline *) +include (Module : Type) + +(** @inline *) +module A = B + +(** @inline *) +module A : sig + type t +end = struct + type t +end + +(** @inline *) +module rec A : sig + type t +end = struct + type t +end + +(** @author B *) +and B : sig + type t +end = struct + type t +end + +(** @deprecated abc *) +module type A = B + +(** @deprecated abc *) +module type A = sig + type t +end + +(** @open *) +module A : sig + type t +end = + B + +(** @deprecated *) +open Module.With_veryyyyyy_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame + +(** @deprecated *) +include Module.With_very_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame + +(** @deprecated *) +module A = Module.With_very_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame + +(** @deprecated *) +type t = T + +(** @deprecated *) +type t = t + +(** @deprecated *) +let a = b + +(** @deprecated *) +type t = t +(** @deprecated *) + +class b = + object + (** @deprecated *) + method f = 0 + + (** @deprecated *) + inherit a + + (** @deprecated *) + val x = 1 + + (** @deprecated *) + constraint 'a = [> ] + + (** @deprecated *) + initializer do_init () + end + +[@@@ocamlformat "doc-comments-tag-only=fit"] + +open Module (** @deprecated *) + +(** abc + + @deprecated *) +open Module + +open Module (** @author A *) + +open Module (** @inline *) + +include Abc (** @inline *) + +(** @inline *) +include struct + type t +end + +include (Module : Type) (** @inline *) + +module A = B (** @inline *) + +(** @inline *) +module A : sig + type t +end = struct + type t +end + +(** @inline *) +module rec A : sig + type t +end = struct + type t +end + +(** @author B *) +and B : sig + type t +end = struct + type t +end + +module type A = B (** @deprecated abc *) + +(** @deprecated abc *) +module type A = sig + type t +end + +(** @open *) +module A : sig + type t +end = + B + +open Module.With_veryyyyyy_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame +(** @deprecated *) + +include Module.With_very_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame +(** @deprecated *) + +module A = Module.With_very_loooooooooooooooooooooooong_naaaaaaaaaaaaaaaaame +(** @deprecated *) + +(** @deprecated *) +type t = T + +type t = t (** @deprecated *) + +(** @deprecated *) +let a = b + +(** @deprecated *) +type t = t +(** @deprecated *) + +class b = + object + method f = 0 (** @deprecated *) + + inherit a (** @deprecated *) + + val x = 1 (** @deprecated *) + + constraint 'a = [> ] (** @deprecated *) + + initializer do_init () (** @deprecated *) + end diff --git a/test/passing/refs.ocamlformat/tag_only.mli.ref b/test/passing/refs.ocamlformat/tag_only.mli.ref new file mode 100644 index 0000000000..fcd87de51d --- /dev/null +++ b/test/passing/refs.ocamlformat/tag_only.mli.ref @@ -0,0 +1,99 @@ +(** @deprecated *) +open Module + +(** abc + + @deprecated *) +open Module + +(** @inline *) +include sig + type t +end + +(** @inline *) +include Type + +(** @inline *) +include module type of Module + +(** @deprecated *) +module A : B + +(** @deprecated *) +module A : sig + type t +end + +(** @open *) +module type A = B + +(** @open *) +module type A = sig + type t +end + +(** @deprecated *) +type t = T + +(** @deprecated *) +type t = {a: int} + +(** @deprecated *) +type t = .. + +(** @deprecated *) +type t + +(** @deprecated *) +type t = t + +val a : b +(** @deprecated *) + +[@@@ocamlformat "doc-comments-tag-only=fit"] + +open Module (** @deprecated *) + +(** abc + + @deprecated *) +open Module + +(** @inline *) +include sig + type t +end + +include Type (** @inline *) + +include module type of Module (** @inline *) + +module A : B (** @deprecated *) + +(** @deprecated *) +module A : sig + type t +end + +module type A = B (** @open *) + +(** @open *) +module type A = sig + type t +end + +(** @deprecated *) +type t = T + +(** @deprecated *) +type t = {a: int} + +type t = .. (** @deprecated *) + +type t (** @deprecated *) + +type t = t (** @deprecated *) + +val a : b +(** @deprecated *) diff --git a/test/passing/refs.ocamlformat/try_with_or_pattern.ml.ref b/test/passing/refs.ocamlformat/try_with_or_pattern.ml.ref new file mode 100644 index 0000000000..fb644303d0 --- /dev/null +++ b/test/passing/refs.ocamlformat/try_with_or_pattern.ml.ref @@ -0,0 +1,5 @@ +let[@ocamlformat "break-cases=all"] _ = + try () with + | End_of_file + |Not_found -> + () diff --git a/test/passing/refs.ocamlformat/tuple.ml.ref b/test/passing/refs.ocamlformat/tuple.ml.ref new file mode 100644 index 0000000000..8e99702b68 --- /dev/null +++ b/test/passing/refs.ocamlformat/tuple.ml.ref @@ -0,0 +1,49 @@ +let _ = + match w with + | A -> + ([], A.(B (C (f x))), None, f x y, g y x) + | B -> + (a, b, c, d, e, f) + | C -> + ( [] + , A.(B (C (this is very looooooooooooooooooooooooooooooooooooong x))) + , None + , f x y + , g y x ) + +let _ = [%ext 1, 2, 3] + +let _ = + [%ext + loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong + , 2 + , 3] + +type t = int [@@deriving 1, 2, 3] + +type t = int +[@@deriving + sexp +, compare +, loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong] + +let _ = + ( 1 + , 2 + , 3 + , looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong + ) + +let _ = (1, 2, 3, short) ;; + +1 +, 2 +, 3 +, looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong +;; + +1, 2, 3, short + +let (a, b) : int * int = + let (a, b) : int * int = (1, 2) in + (a, b) diff --git a/test/passing/refs.ocamlformat/tuple_less_parens.ml.ref b/test/passing/refs.ocamlformat/tuple_less_parens.ml.ref new file mode 100644 index 0000000000..571d8032cb --- /dev/null +++ b/test/passing/refs.ocamlformat/tuple_less_parens.ml.ref @@ -0,0 +1,47 @@ +let _ = + match w with + | A -> + [], A.(B (C (f x))), None, f x y, g y x + | B -> + a, b, c, d, e, f + | C -> + ( [] + , A.(B (C (this is very looooooooooooooooooooooooooooooooooooong x))) + , None + , f x y + , g y x ) + +let _ = [%ext 1, 2, 3] + +let _ = + [%ext + loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong + , 2 + , 3] + +type t = int [@@deriving 1, 2, 3] + +type t = int +[@@deriving + sexp +, compare +, loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong] + +let _ = + ( 1 + , 2 + , 3 + , looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong ) + +let _ = 1, 2, 3, short ;; + +1 +, 2 +, 3 +, looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong +;; + +1, 2, 3, short + +(* make sure to not drop parens for local open. *) +let _ = A.(1, 2) diff --git a/test/passing/refs.ocamlformat/tuple_type_parens.ml.ref b/test/passing/refs.ocamlformat/tuple_type_parens.ml.ref new file mode 100644 index 0000000000..f4ad24d4eb --- /dev/null +++ b/test/passing/refs.ocamlformat/tuple_type_parens.ml.ref @@ -0,0 +1,5 @@ +type t = A of a * (b -> unit) + +type u = B of c + +and v = d * e diff --git a/test/passing/refs.ocamlformat/type_and_constraint.ml.ref b/test/passing/refs.ocamlformat/type_and_constraint.ml.ref new file mode 100644 index 0000000000..34c2062917 --- /dev/null +++ b/test/passing/refs.ocamlformat/type_and_constraint.ml.ref @@ -0,0 +1 @@ +type 'a t = 'a list constraint 'a = [< `X] diff --git a/test/passing/refs.ocamlformat/type_annotations.ml.ref b/test/passing/refs.ocamlformat/type_annotations.ml.ref new file mode 100644 index 0000000000..5711b74bd1 --- /dev/null +++ b/test/passing/refs.ocamlformat/type_annotations.ml.ref @@ -0,0 +1,13 @@ +let f = match None with (_ : int option) -> true + +let f (x : int) : int = e + +let f (x as y : int) : int = e + +let f ((x : int) as y) : int = e + +let f ((x : int) : int) = e + +let _ = match x with exception (e : exn) -> true | _ -> false + +let x = (0 : int :> int) diff --git a/test/passing/tests/types-compact-space_around-docked.ml.ref b/test/passing/refs.ocamlformat/types-compact-space_around-docked.ml.ref similarity index 95% rename from test/passing/tests/types-compact-space_around-docked.ml.ref rename to test/passing/refs.ocamlformat/types-compact-space_around-docked.ml.ref index 79ea6a6155..f9d7b98498 100644 --- a/test/passing/tests/types-compact-space_around-docked.ml.ref +++ b/test/passing/refs.ocamlformat/types-compact-space_around-docked.ml.ref @@ -80,7 +80,8 @@ type t = val x : [ `X of int (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] val x : [ `X of @@ -90,12 +91,14 @@ val x : * fooooooooooo foooooooooo * foooooooooooo (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] val x : [ `X of int (* booooom *) (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] val x : [ `X of @@ -106,7 +109,8 @@ val x : * foooooooooooo (* boooooom *) (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] type voting_period = Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = diff --git a/test/passing/tests/types-compact-space_around.ml.ref b/test/passing/refs.ocamlformat/types-compact-space_around.ml.ref similarity index 95% rename from test/passing/tests/types-compact-space_around.ml.ref rename to test/passing/refs.ocamlformat/types-compact-space_around.ml.ref index 465ab8737c..dc122c3793 100644 --- a/test/passing/tests/types-compact-space_around.ml.ref +++ b/test/passing/refs.ocamlformat/types-compact-space_around.ml.ref @@ -78,7 +78,8 @@ type t = val x : [ `X of int (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] val x : [ `X of @@ -88,12 +89,14 @@ val x : * fooooooooooo foooooooooo * foooooooooooo (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] val x : [ `X of int (* booooom *) (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] val x : [ `X of @@ -104,7 +107,8 @@ val x : * foooooooooooo (* boooooom *) (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] type voting_period = Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = diff --git a/test/passing/tests/types-compact.ml.ref b/test/passing/refs.ocamlformat/types-compact.ml.ref similarity index 95% rename from test/passing/tests/types-compact.ml.ref rename to test/passing/refs.ocamlformat/types-compact.ml.ref index a8b718ab47..182f07c0a0 100644 --- a/test/passing/tests/types-compact.ml.ref +++ b/test/passing/refs.ocamlformat/types-compact.ml.ref @@ -78,7 +78,8 @@ type t = val x : [ `X of int (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] val x : [ `X of @@ -88,12 +89,14 @@ val x : * fooooooooooo foooooooooo * foooooooooooo (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] val x : [ `X of int (* booooom *) (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] val x : [ `X of @@ -104,7 +107,8 @@ val x : * foooooooooooo (* boooooom *) (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] type voting_period = Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = diff --git a/test/passing/tests/types-indent.ml.ref b/test/passing/refs.ocamlformat/types-indent.ml.ref similarity index 94% rename from test/passing/tests/types-indent.ml.ref rename to test/passing/refs.ocamlformat/types-indent.ml.ref index d1d04a46a0..4e187ee2d2 100644 --- a/test/passing/tests/types-indent.ml.ref +++ b/test/passing/refs.ocamlformat/types-indent.ml.ref @@ -78,7 +78,8 @@ type t = val x : [ `X of int (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] val x : [ `X of @@ -88,12 +89,14 @@ val x : * fooooooooooo foooooooooo * foooooooooooo (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] val x : [ `X of int (* booooom *) (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] val x : [ `X of @@ -104,7 +107,8 @@ val x : * foooooooooooo (* boooooom *) (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] type voting_period = Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = @@ -219,6 +223,5 @@ type t = type t = | Foo - | Store of - {exp1: Exp.t; typ: Typ.t option; exp2: Exp.t; loc: Location.t} + | Store of {exp1: Exp.t; typ: Typ.t option; exp2: Exp.t; loc: Location.t} (** *exp1 <- exp2 with exp2:typ *) diff --git a/test/passing/tests/types-sparse-space_around.ml.ref b/test/passing/refs.ocamlformat/types-sparse-space_around.ml.ref similarity index 100% rename from test/passing/tests/types-sparse-space_around.ml.ref rename to test/passing/refs.ocamlformat/types-sparse-space_around.ml.ref diff --git a/test/passing/tests/types-sparse.ml.ref b/test/passing/refs.ocamlformat/types-sparse.ml.ref similarity index 95% rename from test/passing/tests/types-sparse.ml.ref rename to test/passing/refs.ocamlformat/types-sparse.ml.ref index ba77762afe..5020f0f066 100644 --- a/test/passing/tests/types-sparse.ml.ref +++ b/test/passing/refs.ocamlformat/types-sparse.ml.ref @@ -96,7 +96,8 @@ type t = val x : [ `X of int (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] val x : [ `X of @@ -106,12 +107,14 @@ val x : * fooooooooooo foooooooooo * foooooooooooo (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] val x : [ `X of int (* booooom *) (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] val x : [ `X of @@ -122,7 +125,8 @@ val x : * foooooooooooo (* boooooom *) (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo - fooooooooooooooooooo fooooooooooooooo *) ] + fooooooooooooooooooo fooooooooooooooo *) + ] type voting_period = Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = diff --git a/test/passing/refs.ocamlformat/types.ml.ref b/test/passing/refs.ocamlformat/types.ml.ref new file mode 100644 index 0000000000..182f07c0a0 --- /dev/null +++ b/test/passing/refs.ocamlformat/types.ml.ref @@ -0,0 +1,227 @@ +type uu = A of int | B of (< leq: 'a > as 'a) + +type uu = A of int | B of (< leq: 'a > as 'a) * 'a + +type uu = A of (int as 'a) | B of 'a * (< leq: 'a > as 'a) + +type uu += A of (int as 'a) + +type uu += B of 'a * (< leq: 'a > as 'a) + +let _ = ignore Async_unix.Fd.(([stdin (); stdout (); stderr ()] : t list)) + +type t = {x: int} + +type t = {a: int; b: int} + +type t = [`A | `B] + +type loooooooooong_type = + {looooooooooooong_field: looooooooooooong_type; field2: type2} + +type t = A of (int * int) * int + +type t = A of int * int + +type t = A of (int * int) + +let _ = match x with Some (Some None) -> t + +type t = .. + +type t = private .. + +type t = u = private .. + +type t += A + +type t += B = A + +type 'a foo = A of (int -> 'a) + +type 'a foo += A of (int -> 'a) + +type 'a foo += A : (int -> 'a) -> int foo + +type t = [ | a] + +type t = private [< a] + +type t = private [> a] + +type t = [a | b] + +type t = [a | b | `C] + +type t = [`a | b] + +type t = | + +type t = [> ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int + | `Looooooooooooooooooooong_variant of string ] + +type loooooooooooooong_type = + [ `Looooooooooooooooooong_type of int (** Doc *) + | `Looooooooooooooooooooong_variant of string (* Comment *) ] + +let (`A | `B) [@bar] = () + +type t = + | Internal_error of + [ `Doc_comment of + [ `Moved of Location.t * Location.t * string + | `Unstable of Location.t * string ] ] + +val x : + [ `X of int + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x : + [ `X of + int + * foooooooooooooo + * fooooooooooo + * fooooooooooo foooooooooo + * foooooooooooo + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x : + [ `X of int (* booooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +val x : + [ `X of + int + * foooooooooooooo + * fooooooooooo + * fooooooooooo foooooooooo + * foooooooooooo + (* boooooom *) + (** foooooooooooooooo foooooooooooooooooooooooo fooooooooooooooooooooooo + fooooooooooooooooooo fooooooooooooooo *) + ] + +type voting_period = + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + +(** foooooooo *) +type voting_period = + (* foooooooooooo *) + (* foooooooooo ooooooooooooooooo ooooooooooooo *) + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind + (* fooooooooooooooo oooooooooooooooooooo ooooooooooooooooooooo *) + (* fooooo *) = + (* foooooooooo *) + | Proposal + | Testing_vote (** fooooooooooo *) + +type ( 'context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint ) + templ_matcher = + { on_objc_cpp: 'context -> 'f_in + ; on_objc_cpp: 'context -> 'f_in + ; on_objc_cpp: 'context -> 'f_in + ; on_objc_cpp: 'context -> 'f_in } + +type ( 'context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint ) + templ_matcher = + ( 'context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint ) + templ_matcher = + { on_objc_cpp: 'context -> 'f_in + ; on_objc_cpp: 'context -> 'f_in + ; on_objc_cpp: 'context -> 'f_in + ; on_objc_cpp: 'context -> 'f_in } + +type ( 'context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint ) + templ_matcher += + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + | On_objc_cpp : 'context -> 'f_in + +module type A = sig + type t := A.t + + type a := A.a + + and b := A.b + + type t := A.t = A | B + + type t := A | B + + type t := A.t = {a: int; b: int} + + and t := {a: int; b: int} + + type t := A.t = .. + + type t := .. +end + +type t = [`A (** A *) | `B [@b] (** B *) | (p[@p]) (* P *)] + +type foooooooooooooooo = + ?fooooooooo:(string -> unit) + -> ?fooooooooooooo: + ( string + -> string + -> int + -> string + -> string option foooooooooooooooooooooooo ) + -> fooooo:string + -> ?fooooooooo:(unit -> unit Fooo.t) + -> ?fooooooo:bool + -> string option Foooooooo.t + +type ' a' t = ' a' + +type ' a' t = ' a' option + +type ' a' t = int as ' a' + +type t = {a: ' a'. ' a' t'} + +type t = + | Foo + | (* Redirect (None, lib) looks up lib in the same database *) + Redirect of db option * (Loc.t * Lib_name.t) + +type t = + | Foo + | Store of {exp1: Exp.t; typ: Typ.t option; exp2: Exp.t; loc: Location.t} + (** *exp1 <- exp2 with exp2:typ *) diff --git a/test/passing/tests/unary.ml.ref b/test/passing/refs.ocamlformat/unary.ml.ref similarity index 100% rename from test/passing/tests/unary.ml.ref rename to test/passing/refs.ocamlformat/unary.ml.ref diff --git a/test/passing/refs.ocamlformat/unary_hash.ml.ref b/test/passing/refs.ocamlformat/unary_hash.ml.ref new file mode 100644 index 0000000000..dbc0af71c9 --- /dev/null +++ b/test/passing/refs.ocamlformat/unary_hash.ml.ref @@ -0,0 +1,19 @@ +let f o x = o##x + +let f x = !#x + +let f x = ?#x + +let f x = ~#x + +let f o x = o#-#x + +let f x = !-#x + +let f x = ?-#x + +let f x = ~-#x + +let f x = ?#(x - y) + +let f x = x + ?#(x + y) diff --git a/test/passing/refs.ocamlformat/unicode.ml.err b/test/passing/refs.ocamlformat/unicode.ml.err new file mode 100644 index 0000000000..c0a43c88ba --- /dev/null +++ b/test/passing/refs.ocamlformat/unicode.ml.err @@ -0,0 +1,2 @@ +Warning: unicode.ml:5 exceeds the margin +Warning: unicode.ml:11 exceeds the margin diff --git a/test/passing/refs.ocamlformat/unicode.ml.ref b/test/passing/refs.ocamlformat/unicode.ml.ref new file mode 100644 index 0000000000..cd28b63063 --- /dev/null +++ b/test/passing/refs.ocamlformat/unicode.ml.ref @@ -0,0 +1,13 @@ +(* Don't edit this file with an editor that perform unicode normalization *) + +(* normal78901234567890123456789012345678901234567890123456789012345678901 a bū + c d e*) + +(* modifier901234567890123456789012345678901234567890123456789012345678901 a bū̃ + c d e*) + +(* 12345678901234567890123456789012345678901234567890123456789012345678901 a yo + c d e*) + +(* 12345678901234567890123456789012345678901234567890123456789012345678901 a y̲o + c d e*) diff --git a/test/passing/refs.ocamlformat/use_file.mlt.ref b/test/passing/refs.ocamlformat/use_file.mlt.ref new file mode 100644 index 0000000000..56d0ff1c12 --- /dev/null +++ b/test/passing/refs.ocamlformat/use_file.mlt.ref @@ -0,0 +1,20 @@ +#p + +#p "a" + +#p 0 ;; + +0 ;; + +#p 0n + +#p M.T.r + +(* comments *) +(* comments *) + +let () = 3 ;; + +2 ;; + +3 diff --git a/test/passing/refs.ocamlformat/variants.ml.ref b/test/passing/refs.ocamlformat/variants.ml.ref new file mode 100644 index 0000000000..2b56420346 --- /dev/null +++ b/test/passing/refs.ocamlformat/variants.ml.ref @@ -0,0 +1,20 @@ +type t = + [(* xx *) `(* yy *) A (* zz *) | (* xx *) `B (* zz *) | `(* yy *) C (* zz *)] + +let (* xx *) `(* yy *) A (* zz *) = x + +let (* xx *) `B (* zz *) = x + +let `(* yy *) C (* zz *) = x + +let _ = (* xx *) `(* yy *) A (* zz *) + +let _ = (* xx *) `B (* zz *) + +let _ = `(* yy *) C (* zz *) + +type t = + [ `Fooooo + | (* Other inline element markup. *) + `Simple_reference of string + | `Fooooo ] diff --git a/test/passing/refs.ocamlformat/verbatim_comments-wrap.ml.ref b/test/passing/refs.ocamlformat/verbatim_comments-wrap.ml.ref new file mode 100644 index 0000000000..c2d7e3b0af --- /dev/null +++ b/test/passing/refs.ocamlformat/verbatim_comments-wrap.ml.ref @@ -0,0 +1,23 @@ +(*= Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* [...] + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +[...] *) + +let _ = + (*= Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* [...] + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +[...] *) + () diff --git a/test/passing/refs.ocamlformat/verbatim_comments.ml.ref b/test/passing/refs.ocamlformat/verbatim_comments.ml.ref new file mode 100644 index 0000000000..c2d7e3b0af --- /dev/null +++ b/test/passing/refs.ocamlformat/verbatim_comments.ml.ref @@ -0,0 +1,23 @@ +(*= Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* [...] + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +[...] *) + +let _ = + (*= Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* [...] + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +[...] *) + () diff --git a/test/passing/refs.ocamlformat/w50.ml.ref b/test/passing/refs.ocamlformat/w50.ml.ref new file mode 100644 index 0000000000..211695b529 --- /dev/null +++ b/test/passing/refs.ocamlformat/w50.ml.ref @@ -0,0 +1,21 @@ +(* When using [--no-comment-check] (to format code despite warning 50), + We should not complain if doc-comments start appearing in the AST. +*) + +module type T = sig + val test_raises_some_exc : ('a -> 'b) -> 'a -> bool + + (** AAAA *) + + val test_raises_this_exc : exn -> ('a -> 'b) -> 'a -> bool + (** BBBB *) +end + +module T = struct + let test_raises_some_exc = 2 + + (** CCCC *) + + (** DDDD *) + let test_raises_this_exc = 3 +end diff --git a/test/passing/refs.ocamlformat/wrap_comments.ml.err b/test/passing/refs.ocamlformat/wrap_comments.ml.err new file mode 100644 index 0000000000..7eab0db6ff --- /dev/null +++ b/test/passing/refs.ocamlformat/wrap_comments.ml.err @@ -0,0 +1,19 @@ +Warning: wrap_comments.ml:59 exceeds the margin +Warning: wrap_comments.ml:184 exceeds the margin +Warning: wrap_comments.ml:185 exceeds the margin +Warning: wrap_comments.ml:186 exceeds the margin +Warning: wrap_comments.ml:190 exceeds the margin +Warning: wrap_comments.ml:191 exceeds the margin +Warning: wrap_comments.ml:192 exceeds the margin +Warning: wrap_comments.ml:195 exceeds the margin +Warning: wrap_comments.ml:196 exceeds the margin +Warning: wrap_comments.ml:197 exceeds the margin +Warning: wrap_comments.ml:202 exceeds the margin +Warning: wrap_comments.ml:203 exceeds the margin +Warning: wrap_comments.ml:204 exceeds the margin +Warning: wrap_comments.ml:208 exceeds the margin +Warning: wrap_comments.ml:209 exceeds the margin +Warning: wrap_comments.ml:210 exceeds the margin +Warning: wrap_comments.ml:213 exceeds the margin +Warning: wrap_comments.ml:214 exceeds the margin +Warning: wrap_comments.ml:215 exceeds the margin diff --git a/test/passing/tests/wrap_comments.ml.ref b/test/passing/refs.ocamlformat/wrap_comments.ml.ref similarity index 100% rename from test/passing/tests/wrap_comments.ml.ref rename to test/passing/refs.ocamlformat/wrap_comments.ml.ref diff --git a/test/passing/refs.ocamlformat/wrap_comments_break.ml.ref b/test/passing/refs.ocamlformat/wrap_comments_break.ml.ref new file mode 100644 index 0000000000..2a8af342ce --- /dev/null +++ b/test/passing/refs.ocamlformat/wrap_comments_break.ml.ref @@ -0,0 +1,8 @@ +let _ = + let _ = + fffffffffff + aaaaaaaaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbbbbbb + ~f:(fun x -> return xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ) + in + 2 diff --git a/test/passing/refs.ocamlformat/wrap_invalid_doc_comments.ml.err b/test/passing/refs.ocamlformat/wrap_invalid_doc_comments.ml.err new file mode 100644 index 0000000000..ee04b36da2 --- /dev/null +++ b/test/passing/refs.ocamlformat/wrap_invalid_doc_comments.ml.err @@ -0,0 +1,6 @@ +Warning: Invalid documentation comment: +File "wrap_invalid_doc_comments.ml", line 2, characters 48-53: +'{v ... v}' (verbatim text) should begin on its own line. +Warning: Invalid documentation comment: +File "wrap_invalid_doc_comments.ml", line 2, characters 48-53: +'{v ... v}' (verbatim text) should not be empty. diff --git a/test/passing/refs.ocamlformat/wrap_invalid_doc_comments.ml.ref b/test/passing/refs.ocamlformat/wrap_invalid_doc_comments.ml.ref new file mode 100644 index 0000000000..5b38098d67 --- /dev/null +++ b/test/passing/refs.ocamlformat/wrap_invalid_doc_comments.ml.ref @@ -0,0 +1,2 @@ +(** - Item 1 + - Item 2, that contains two block elements: {v v} *) diff --git a/test/passing/refs.ocamlformat/wrapping_functor_args.ml.err b/test/passing/refs.ocamlformat/wrapping_functor_args.ml.err new file mode 100644 index 0000000000..d5b0b1c7f4 --- /dev/null +++ b/test/passing/refs.ocamlformat/wrapping_functor_args.ml.err @@ -0,0 +1 @@ +Warning: wrapping_functor_args.ml:25 exceeds the margin diff --git a/test/passing/refs.ocamlformat/wrapping_functor_args.ml.ref b/test/passing/refs.ocamlformat/wrapping_functor_args.ml.ref new file mode 100644 index 0000000000..86b0e237a8 --- /dev/null +++ b/test/passing/refs.ocamlformat/wrapping_functor_args.ml.ref @@ -0,0 +1,44 @@ +(* This declaration looks odd *) +type request_token = + Sociaml_oauth_client.Client.Make(Sociaml_oauth_client.Posix.Clock) + (Sociaml_oauth_client.Posix.MAC_SHA1) + (Sociaml_oauth_client.Posix.Random) + .request_token + +(* Whereas this one works well *) +module OauthClient = + Sociaml_oauth_client.Client.Make + (Sociaml_oauth_client.Posix.Clock) + (Sociaml_oauth_client.Posix.MAC_SHA1) + (Sociaml_oauth_client.Posix.Random) + +module F1 + (G : functor (_ : T) -> T) + (A : sig + val x : int + end) = +struct end + +module F2 + (G : functor + (_ : T) + -> + T_________________________________________________________________________) + (A : sig + val x : int + end) = +struct end + +module F3 + (G : functor + (_ : T____________________________________________) + (_ : T____________________________________________) + -> T) + (A : sig + val x : int + end) = +struct end + +module F (* test *) (M : sig + type t +end) : S = struct end diff --git a/test/passing/tests/.ocamlformat b/test/passing/tests/.ocamlformat deleted file mode 100644 index ebccd4584d..0000000000 --- a/test/passing/tests/.ocamlformat +++ /dev/null @@ -1,7 +0,0 @@ -profile = ocamlformat -break-cases = fit -margin = 77 -parse-docstrings = true -wrap-comments = true -max-iters = 2 -ocaml-version = 4.13.0 diff --git a/test/passing/tests/.ocp-indent b/test/passing/tests/.ocp-indent deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/alignment.ml.ref b/test/passing/tests/alignment.ml.ref deleted file mode 100644 index afc0ce0070..0000000000 --- a/test/passing/tests/alignment.ml.ref +++ /dev/null @@ -1,18 +0,0 @@ -let file_contents = [] @ [foo] @ [bar] - -let _ = - match s.src with - | None -> [zz] + 2 - | Some s -> - [ Variable (s_src, OpamFormat.make_string (OpamFilename.to_string s)) - ; yy ] ; - foo - | Some s -> - { fww= (s_src, OpamFormat.make_string (OpamFilename.to_string s)) - ; gdd= yy } - -let _ = [x; y] @ z - -let _ = [x; y] @ z - -let _ = [x; y] @ z diff --git a/test/passing/tests/args_grouped-conventional.ml.err b/test/passing/tests/args_grouped-conventional.ml.err deleted file mode 100644 index 72700d3e20..0000000000 --- a/test/passing/tests/args_grouped-conventional.ml.err +++ /dev/null @@ -1,27 +0,0 @@ -Warning: tests/args_grouped.ml:0 exceeds the margin -Warning: tests/args_grouped.ml:4 exceeds the margin -Warning: tests/args_grouped.ml:5 exceeds the margin -Warning: tests/args_grouped.ml:6 exceeds the margin -Warning: tests/args_grouped.ml:7 exceeds the margin -Warning: tests/args_grouped.ml:8 exceeds the margin -Warning: tests/args_grouped.ml:9 exceeds the margin -Warning: tests/args_grouped.ml:17 exceeds the margin -Warning: tests/args_grouped.ml:24 exceeds the margin -Warning: tests/args_grouped.ml:38 exceeds the margin -Warning: tests/args_grouped.ml:47 exceeds the margin -Warning: tests/args_grouped.ml:51 exceeds the margin -Warning: tests/args_grouped.ml:66 exceeds the margin -Warning: tests/args_grouped.ml:84 exceeds the margin -Warning: tests/args_grouped.ml:96 exceeds the margin -Warning: tests/args_grouped.ml:103 exceeds the margin -Warning: tests/args_grouped.ml:105 exceeds the margin -Warning: tests/args_grouped.ml:123 exceeds the margin -Warning: tests/args_grouped.ml:124 exceeds the margin -Warning: tests/args_grouped.ml:137 exceeds the margin -Warning: tests/args_grouped.ml:141 exceeds the margin -Warning: tests/args_grouped.ml:145 exceeds the margin -Warning: tests/args_grouped.ml:150 exceeds the margin -Warning: tests/args_grouped.ml:155 exceeds the margin -Warning: tests/args_grouped.ml:159 exceeds the margin -Warning: tests/args_grouped.ml:160 exceeds the margin -Warning: tests/args_grouped.ml:165 exceeds the margin diff --git a/test/passing/tests/args_grouped-conventional.ml.opts b/test/passing/tests/args_grouped-conventional.ml.opts deleted file mode 100644 index cfd48affd9..0000000000 --- a/test/passing/tests/args_grouped-conventional.ml.opts +++ /dev/null @@ -1,3 +0,0 @@ ---profile=conventional ---margin=30 ---max-iters=3 diff --git a/test/passing/tests/args_grouped-conventional.ml.ref b/test/passing/tests/args_grouped-conventional.ml.ref deleted file mode 100644 index 07c6bfba7f..0000000000 --- a/test/passing/tests/args_grouped-conventional.ml.ref +++ /dev/null @@ -1,167 +0,0 @@ -let nullsafe_optimistic_third_party_params_in_non_strict - = - CLOpt.mk_bool - ~long: - "nullsafe-optimistic-third-party-params-in-non-strict" - (* Turned on for compatibility reasons. Historically this is because - there was no actionable way to change third party annotations. Now - that we have such a support, this behavior should be reconsidered, - provided our tooling and error reporting is friendly enough to be - smoothly used by developers. *) - ~default:true - "Nullsafe: in this mode \ - we treat non annotated \ - third party method \ - params as if they were \ - annotated as nullable." - -let test_file_renamings_from_json - = - let create_test test_input - expected_output _ = - let test_output input = - DifferentialFilters - .FileRenamings - .VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY - .from_json input - in - foo - in - fooooooooooooooo - -let eval location exp0 astate - = - let rec eval exp astate = - match (exp : Exp.t) with - | Var id -> - Ok - (eval_var - (* error in case of missing history? *) - [] - (Var.of_id id) - astate) - | Lvar pvar -> - Ok - (eval_var - [ - ValueHistory - .VariableAccessed - ( pvar, - location ); - ] - (Var.of_pvar pvar) - astate) - | Lfield (exp', field, _) - -> - goooooooo - in - fooooooooooooooooooooo - -let declare_locals_and_ret - tenv pdesc - (prop_ : - Prop.normal Prop.t) = - let foooooooooooooo = - BiabductionConfig - .run_in_re_execution_mode - (* no footprint vars for locals *) - sigma_locals_and_ret () - in - fooooooooooooooooooooooooooo - -let bottom_up fooooooooooo = - let empty = - Int.equal 0 !scheduled - && Queue.is_empty pending - in - if empty then ( - remaining := 0; - L.progress - "Finished call graph \ - scheduling, %d procs \ - remaining (in, or \ - reaching, cycles).@." - (CallGraph.n_procs - syntactic_call_graph); - if - Config - .debug_level_analysis - > 0 - then - CallGraph.to_dotty - syntactic_call_graph - "cycles.dot"; - foooooooooooooooooo) - else fooooooooooooooooo - -let test_file_renamings_from_json - = - let fooooooooooooo = - match expected_output with - | Return exp -> - assert_equal ~pp_diff - ~cmp: - DifferentialFilters - .FileRenamings - .VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY - .equal exp - (test_output - test_input) - | Raise exc -> - assert_raises exc - (fun () -> - test_output - test_input) - in - foooooooooooooooo - -let gen_with_record_deps - ~expand t resolved_forms - ~dep_kind = - let foooooooooooooooooooooo - = - expand - (* we keep the dir constant here to replicate the old behavior of: - (chdir foo %{exe:bar}). This should lookup ./bar rather than - ./foo/bar *) - resolved_forms - ~dir:t.dir ~dep_kind - ~expand_var:t.expand_var - in - { t with expand_var } - -let f = - very_long_function_name - ~very_long_variable_name: - (very_long expression) - (* this is a - multiple-line-spanning - comment *) - ~y - -let eradicate_meta_class_is_nullsafe - = - register - ~id: - "ERADICATE_META_CLASS_IS_NULLSAFE" - ~hum: - "Class is marked \ - @Nullsafe and has 0 \ - issues" - (* Should be enabled for special integrations *) - ~enabled:false Info - Eradicate (* TODO *) - ~user_documentation:"" - -let eradicate_meta_class_is_nullsafe - = - register - ~id: - "ERADICATE_META_CLASS_IS_NULLSAFE" - (* Should be enabled for special integrations *) - ~hum: - "Class is marked \ - @Nullsafe and has 0 \ - issues" - (* Should be enabled for special integrations *) - ~enabled:false Info diff --git a/test/passing/tests/args_grouped.ml.opts b/test/passing/tests/args_grouped.ml.opts index 6e582beef0..700a2862db 100644 --- a/test/passing/tests/args_grouped.ml.opts +++ b/test/passing/tests/args_grouped.ml.opts @@ -1,2 +1 @@ ---profile=ocamlformat --margin=100 diff --git a/test/passing/tests/break_record.ml.opts b/test/passing/tests/break_record.ml.opts index 7862b92895..59d2cd9f91 100644 --- a/test/passing/tests/break_record.ml.opts +++ b/test/passing/tests/break_record.ml.opts @@ -1,2 +1 @@ ---profile=janestreet --margin=58 diff --git a/test/passing/tests/dir1/.ocamlformat b/test/passing/tests/dir1/.ocamlformat deleted file mode 100644 index bfbbecfed4..0000000000 --- a/test/passing/tests/dir1/.ocamlformat +++ /dev/null @@ -1 +0,0 @@ -module-item-spacing = compact diff --git a/test/passing/tests/dir1/dir2/.ocamlformat b/test/passing/tests/dir1/dir2/.ocamlformat deleted file mode 100644 index 332a43a937..0000000000 --- a/test/passing/tests/dir1/dir2/.ocamlformat +++ /dev/null @@ -1 +0,0 @@ -module-item-spacing = sparse diff --git a/test/passing/tests/dir1/dir2/print_config.ml b/test/passing/tests/dir1/dir2/print_config.ml deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/error1.ml.ref b/test/passing/tests/error1.ml.ref deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/error2.ml.ref b/test/passing/tests/error2.ml.ref deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/error3.ml.ref b/test/passing/tests/error3.ml.ref deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/into_infix.opts b/test/passing/tests/into_infix.opts deleted file mode 100644 index 37c78e5d93..0000000000 --- a/test/passing/tests/into_infix.opts +++ /dev/null @@ -1 +0,0 @@ ---profile=janestreet diff --git a/test/passing/tests/js_record.ml.opts b/test/passing/tests/js_record.ml.opts index 7f32d0ac13..a2f04741b8 100644 --- a/test/passing/tests/js_record.ml.opts +++ b/test/passing/tests/js_record.ml.opts @@ -1,2 +1 @@ ---profile=janestreet --max-iter=3 diff --git a/test/passing/tests/js_sig.mli.opts b/test/passing/tests/js_sig.mli.opts deleted file mode 100644 index 37c78e5d93..0000000000 --- a/test/passing/tests/js_sig.mli.opts +++ /dev/null @@ -1 +0,0 @@ ---profile=janestreet diff --git a/test/passing/tests/js_source.ml b/test/passing/tests/js_source.ml index e154f46bea..d76ad02d6f 100644 --- a/test/passing/tests/js_source.ml +++ b/test/passing/tests/js_source.ml @@ -1,7367 +1,10 @@ -[@@@foo] - -let (x[@foo]) : unit [@foo] = ()[@foo] - [@@foo] - -type t = - | Foo of (t[@foo]) [@foo] -[@@foo] - -[@@@foo] - - -module M = struct - type t = { - l : (t [@foo]) [@foo] - } - [@@foo] - [@@foo] - - [@@@foo] -end[@foo] -[@@foo] - -module type S = sig - - include (module type of (M[@foo]))[@foo] with type t := M.t[@foo] - [@@foo] - - [@@@foo] - -end[@foo] -[@@foo] - -[@@@foo] -type 'a with_default - = ?size:int (** default [42] *) - -> ?resizable:bool (** default [true] *) - -> 'a - -type obj = < - meth1 : int -> int; - (** method 1 *) - - meth2: unit -> float (** method 2 *); -> - -type var = [ - | `Foo (** foo *) - | `Bar of int * string (** bar *) -] - -[%%foo let x = 1 in x] -let [%foo 2+1] : [%foo bar.baz] = [%foo "foo"] - -[%%foo module M = [%bar] ] -let [%foo let () = () ] : [%foo type t = t ] = [%foo class c = object end] - -[%%foo: 'a list] -let [%foo: [`Foo] ] : [%foo: t -> t ] = [%foo: < foo : t > ] - -[%%foo? _ ] -[%%foo? Some y when y > 0] -let [%foo? (Bar x | Baz x) ] : [%foo? #bar ] = [%foo? { x }] - -[%%foo: module M : [%baz]] -let [%foo: include S with type t = t ] - : [%foo: val x : t val y : t] - = [%foo: type t = t ] -let int_with_custom_modifier = - 1234567890_1234567890_1234567890_1234567890_1234567890z -let float_with_custom_modifier = - 1234567890_1234567890_1234567890_1234567890_1234567890.z - -let int32 = 1234l -let int64 = 1234L -let nativeint = 1234n - -let hex_without_modifier = 0x32f -let hex_with_modifier = 0x32g - -let float_without_modifer = 1.2e3 -let float_with_modifer = 1.2g -let%foo x = 42 -let%foo _ = () and _ = () -let%foo _ = () - -(* Expressions *) -let () = - let%foo[@foo] x = 3 - and[@foo] y = 4 in - (let module%foo[@foo] M = M in ()) ; - (let open%foo[@foo] M in ()) ; - (fun%foo[@foo] x -> ()) ; - (function%foo[@foo] x -> ()) ; - (try%foo[@foo] () with _ -> ()) ; - (if%foo[@foo] () then () else ()) ; - while%foo[@foo] () do () done ; - for%foo[@foo] x = () to () do () done ; - assert%foo[@foo] true ; - lazy%foo[@foo] x ; - object%foo[@foo] end ; - begin%foo[@foo] 3 end ; - new%foo[@foo] x ; - - match%foo[@foo] () with - (* Pattern expressions *) - | lazy%foo[@foo] x -> () - | exception%foo[@foo] x -> () - -(* Class expressions *) -class x = - fun[@foo] x -> - let[@foo] x = 3 in - object[@foo] - inherit[@foo] x - val[@foo] x = 3 - val[@foo] virtual x : t - val![@foo] mutable x = 3 - method[@foo] x = 3 - method[@foo] virtual x : t - method![@foo] private x = 3 - initializer[@foo] x - end - -(* Class type expressions *) -class type t = - object[@foo] - inherit[@foo] t - val[@foo] x : t - val[@foo] mutable x : t - method[@foo] x : t - method[@foo] private x : t - constraint[@foo] t = t' - [@@@abc] - [%%id] - [@@@aaa] - end - -(* Type expressions *) -type t = - (module%foo[@foo] M) - -(* Module expressions *) -module M = - functor[@foo] (M : S) -> - (val[@foo] x) - (struct[@foo] end) - -(* Module type expression *) -module type S = - functor[@foo] (M:S) -> - (module type of[@foo] M) -> - (sig[@foo] end) - -module type S = S -> S -> S -module type S = (S -> S) -> S -module type S = functor (M : S) -> S -> S -module type S = (functor (M : S) -> S) -> S -module type S = (S -> S)[@foo] -> S -module type S = (functor[@foo] (M : S) -> S) -> S - -module type S = sig - module rec A : (S with type t = t) - and B : (S with type t = t) -end - -(* Structure items *) -let%foo[@foo] x = 4 -and[@foo] y = x - -type%foo[@foo] t = int -and[@foo] t = int -type%foo[@foo] t += T - -class%foo[@foo] x = x -class type%foo[@foo] x = x -external%foo[@foo] x : _ = "" -exception%foo[@foo] X - -module%foo[@foo] M = M -module%foo[@foo] rec M : S = M -and[@foo] M : S = M -module type%foo[@foo] S = S - -include%foo[@foo] M -open%foo[@foo] M - -(* Signature items *) -module type S = sig - val%foo[@foo] x : t - external%foo[@foo] x : t = "" - - type%foo[@foo] t = int - and[@foo] t' = int - type%foo[@foo] t += T - - exception%foo[@foo] X - - module%foo[@foo] M : S - module%foo[@foo] rec M : S - and[@foo] M : S - module%foo[@foo] M = M - - module type%foo[@foo] S = S - - include%foo[@foo] M - open%foo[@foo] M - - class%foo[@foo] x : t - class type%foo[@foo] x = x - - class%foo x : t [@@foo] - class type%foo x = x [@@foo] - -end - -type t = ..;; -type t += A;; - -[%extension_constructor A];; -([%extension_constructor A] : extension_constructor);; - -module M = struct - type extension_constructor = int -end;; - -open M;; - -([%extension_constructor A] : extension_constructor);; - -(* By using two types we can have a recursive constraint *) -type 'a class_name = .. constraint 'a = < cast: 'a. 'a name -> 'a; ..> -and 'a name = - Class : 'a class_name -> (< cast: 'a. 'a name -> 'a; ..> as 'a) name -;; - -exception Bad_cast -;; - -class type castable = -object - method cast: 'a.'a name -> 'a -end -;; - -(* Lets create a castable class with a name*) - -class type foo_t = -object - inherit castable - method foo: string -end -;; - -type 'a class_name += Foo: foo_t class_name -;; - -class foo: foo_t = -object(self) - method cast: type a. a name -> a = - function - Class Foo -> (self :> foo_t) - | _ -> ((raise Bad_cast) : a) - method foo = "foo" -end -;; - -(* Now we can create a subclass of foo *) - -class type bar_t = -object - inherit foo - method bar: string -end -;; - -type 'a class_name += Bar: bar_t class_name -;; - -class bar: bar_t = -object(self) - inherit foo as super - method cast: type a. a name -> a = - function - Class Bar -> (self :> bar_t) - | other -> super#cast other - method bar = "bar" - [@@@id] - [%%id] -end -;; - -(* Now lets create a mutable list of castable objects *) - -let clist :castable list ref = ref [] -;; - -let push_castable (c: #castable) = - clist := (c :> castable) :: !clist -;; - -let pop_castable () = - match !clist with - c :: rest -> - clist := rest; - c - | [] -> raise Not_found -;; - -(* We can add foos and bars to this list, and retrive them *) - -push_castable (new foo);; -push_castable (new bar);; -push_castable (new foo);; - -let c1: castable = pop_castable ();; -let c2: castable = pop_castable ();; -let c3: castable = pop_castable ();; - -(* We can also downcast these values to foos and bars *) - -let f1: foo = c1#cast (Class Foo);; (* Ok *) -let f2: foo = c2#cast (Class Foo);; (* Ok *) -let f3: foo = c3#cast (Class Foo);; (* Ok *) - -let b1: bar = c1#cast (Class Bar);; (* Exception Bad_cast *) -let b2: bar = c2#cast (Class Bar);; (* Ok *) -let b3: bar = c3#cast (Class Bar);; (* Exception Bad_cast *) - -type foo = .. -;; - -type foo += - A - | B of int -;; - -let is_a x = - match x with - A -> true - | _ -> false -;; - -(* The type must be open to create extension *) - -type foo -;; - -type foo += A of int (* Error type is not open *) -;; - -(* The type parameters must match *) - -type 'a foo = .. -;; - -type ('a, 'b) foo += A of int (* Error: type parameter mismatch *) -;; - -(* In a signature the type does not have to be open *) - -module type S = -sig - type foo - type foo += A of float -end -;; - -(* But it must still be extensible *) - -module type S = -sig - type foo = A of int - type foo += B of float (* Error foo does not have an extensible type *) -end -;; - -(* Signatures can change the grouping of extensions *) - -type foo = .. -;; - -module M = struct - type foo += - A of int - | B of string - - type foo += - C of int - | D of float -end -;; - -module type S = sig - type foo += - B of string - | C of int - - type foo += D of float - - type foo += A of int -end -;; - -module M_S = (M : S) -;; - -(* Extensions can be GADTs *) - -type 'a foo = .. -;; - -type _ foo += - A : int -> int foo - | B : int foo -;; - -let get_num : type a. a foo -> a -> a option = fun f i1 -> - match f with - A i2 -> Some (i1 + i2) - | _ -> None -;; - -(* Extensions must obey constraints *) - -type 'a foo = .. constraint 'a = [> `Var ] -;; - -type 'a foo += A of 'a -;; - -let a = A 9 (* ERROR: Constraints not met *) -;; - -type 'a foo += B : int foo (* ERROR: Constraints not met *) -;; - -(* Signatures can make an extension private *) - -type foo = .. -;; - -module M = struct type foo += A of int end -;; - -let a1 = M.A 10 -;; - -module type S = sig type foo += private A of int end -;; - -module M_S = (M : S) -;; - -let is_s x = - match x with - M_S.A _ -> true - | _ -> false -;; - -let a2 = M_S.A 20 (* ERROR: Cannot create a value using a private constructor *) -;; - -(* Extensions can be rebound *) - -type foo = .. -;; - -module M = struct type foo += A1 of int end -;; - -type foo += A2 = M.A1 -;; - -type bar = .. -;; - -type bar += A3 = M.A1 (* Error: rebind wrong type *) -;; - -module M = struct type foo += private B1 of int end -;; - -type foo += private B2 = M.B1 -;; - -type foo += B3 = M.B1 (* Error: rebind private extension *) -;; - -type foo += C = Unknown (* Error: unbound extension *) -;; - -(* Extensions can be rebound even if type is closed *) - -module M : sig type foo type foo += A1 of int end - = struct type foo = .. type foo += A1 of int end - -type M.foo += A2 = M.A1 - -(* Rebinding handles abbreviations *) - -type 'a foo = .. -;; - -type 'a foo1 = 'a foo = .. -;; - -type 'a foo2 = 'a foo = .. -;; - -type 'a foo1 += - A of int - | B of 'a - | C : int foo1 -;; - -type 'a foo2 += - D = A - | E = B - | F = C -;; - -(* Extensions must obey variances *) - -type +'a foo = .. -;; - -type 'a foo += A of (int -> 'a) -;; - -type 'a foo += B of ('a -> int) - (* ERROR: Parameter variances are not satisfied *) -;; - -type _ foo += C : ('a -> int) -> 'a foo - (* ERROR: Parameter variances are not satisfied *) -;; - -type 'a bar = .. -;; - -type +'a bar += D of (int -> 'a) (* ERROR: type variances do not match *) -;; - -(* Exceptions are compatible with extensions *) - -module M : sig - type exn += - Foo of int * float - | Bar : 'a list -> exn -end = struct - exception Bar : 'a list -> exn - exception Foo of int * float -end -;; - -module M : sig - exception Bar : 'a list -> exn - exception Foo of int * float -end = struct - type exn += - Foo of int * float - | Bar : 'a list -> exn -end -;; - -exception Foo of int * float -;; - -exception Bar : 'a list -> exn -;; - -module M : sig - type exn += - Foo of int * float - | Bar : 'a list -> exn -end = struct - exception Bar = Bar - exception Foo = Foo -end -;; - -(* Test toplevel printing *) - -type foo = .. -;; - -type foo += - Foo of int * int option - | Bar of int option -;; - -let x = Foo(3, Some 4), Bar(Some 5) (* Prints Foo and Bar successfully *) -;; - -type foo += Foo of string -;; - -let y = x (* Prints Bar but not Foo (which has been shadowed) *) -;; - -exception Foo of int * int option -;; - -exception Bar of int option -;; - -let x = Foo(3, Some 4), Bar(Some 5) (* Prints Foo and Bar successfully *) -;; - -type foo += Foo of string -;; - -let y = x (* Prints Bar and part of Foo (which has been shadowed) *) -;; - -(* Test Obj functions *) - -type foo = .. -;; - -type foo += - Foo - | Bar of int -;; - -let extension_name e = Obj.extension_name (Obj.extension_constructor e);; -let extension_id e = Obj.extension_id (Obj.extension_constructor e);; - -let n1 = extension_name Foo -;; - -let n2 = extension_name (Bar 1) -;; - -let t = (extension_id (Bar 2)) = (extension_id (Bar 3)) (* true *) -;; - -let f = (extension_id (Bar 2)) = (extension_id Foo) (* false *) -;; - -let is_foo x = (extension_id Foo) = (extension_id x) - -type foo += Foo -;; - -let f = is_foo Foo -;; - -let _ = Obj.extension_constructor 7 (* Invald_arg *) -;; - -let _ = Obj.extension_constructor (object method m = 3 end) (* Invald_arg *) -;; -(* Typed names *) - -module Msg : sig - - type 'a tag - - type result = Result : 'a tag * 'a -> result - - val write : 'a tag -> 'a -> unit - - val read : unit -> result - - type 'a tag += Int : int tag - - module type Desc = sig - type t - val label : string - val write : t -> string - val read : string -> t - end - - module Define (D : Desc) : sig - type 'a tag += C : D.t tag - end - -end = struct - - type 'a tag = .. - - type ktag = T : 'a tag -> ktag - - type 'a kind = - { tag : 'a tag; - label : string; - write : 'a -> string; - read : string -> 'a; } - - type rkind = K : 'a kind -> rkind - - type wkind = { f : 'a . 'a tag -> 'a kind } - - let readTbl : (string, rkind) Hashtbl.t = Hashtbl.create 13 - - let writeTbl : (ktag, wkind) Hashtbl.t = Hashtbl.create 13 - - let read_raw () : string * string = raise (Failure "Not implemented") - - type result = Result : 'a tag * 'a -> result - - let read () = - let label, content = read_raw () in - let K k = Hashtbl.find readTbl label in - let body = k.read content in - Result(k.tag, body) - - let write_raw (label : string) (content : string) = - raise (Failure "Not implemented") - - let write (tag : 'a tag) (body : 'a) = - let {f} = Hashtbl.find writeTbl (T tag) in - let k = f tag in - let content = k.write body in - write_raw k.label content - - (* Add int kind *) - - type 'a tag += Int : int tag - - let ik = - { tag = Int; - label = "int"; - write = string_of_int; - read = int_of_string } - - let () = Hashtbl.add readTbl "int" (K ik) - - let () = - let f (type t) (i : t tag) : t kind = - match i with - Int -> ik - | _ -> assert false - in - Hashtbl.add writeTbl (T Int) {f} - - (* Support user defined kinds *) - - module type Desc = sig - type t - val label : string - val write : t -> string - val read : string -> t - end - - module Define (D : Desc) = struct - type 'a tag += C : D.t tag - let k = - { tag = C; - label = D.label; - write = D.write; - read = D.read } - let () = Hashtbl.add readTbl D.label (K k) - let () = - let f (type t) (c : t tag) : t kind = - match c with - C -> k - | _ -> assert false - in - Hashtbl.add writeTbl (T C) {f} - end - -end;; - -let write_int i = Msg.write Msg.Int i;; - -module StrM = Msg.Define(struct - type t = string - let label = "string" - let read s = s - let write s = s -end);; - -type 'a Msg.tag += String = StrM.C;; - -let write_string s = Msg.write String s;; - -let read_one () = - let Msg.Result(tag, body) = Msg.read () in - match tag with - Msg.Int -> print_int body - | String -> print_string body - | _ -> print_string "Unknown";; -(* Example of algorithm parametrized with modules *) - -let sort (type s) set l = - let module Set = (val set : Set.S with type elt = s) in - Set.elements (List.fold_right Set.add l Set.empty) - -let make_set (type s) cmp = - let module S = Set.Make(struct - type t = s - let compare = cmp - end) in - (module S : Set.S with type elt = s) - -let both l = - List.map - (fun set -> sort set l) - [ make_set compare; make_set (fun x y -> compare y x) ] - -let () = - print_endline (String.concat " " (List.map (String.concat "/") - (both ["abc";"xyz";"def"]))) - - -(* Hiding the internal representation *) - -module type S = sig - type t - val to_string: t -> string - val apply: t -> t - val x: t -end - -let create (type s) to_string apply x = - let module M = struct - type t = s - let to_string = to_string - let apply = apply - let x = x - end in - (module M : S with type t = s) - -let forget (type s) x = - let module M = (val x : S with type t = s) in - (module M : S) - -let print x = - let module M = (val x : S) in - print_endline (M.to_string M.x) - -let apply x = - let module M = (val x : S) in - let module N = struct - include M - let x = apply x - end in - (module N : S) - -let () = - let int = forget (create string_of_int succ 0) in - let str = forget (create (fun s -> s) (fun s -> s ^ s) "X") in - List.iter print (List.map apply [int; apply int; apply (apply str)]) - - -(* Existential types + type equality witnesses -> pseudo GADT *) - -module TypEq : sig - type ('a, 'b) t - val apply: ('a, 'b) t -> 'a -> 'b - val refl: ('a, 'a) t - val sym: ('a, 'b) t -> ('b, 'a) t -end = struct - type ('a, 'b) t = unit - let apply _ = Obj.magic - let refl = () - let sym () = () -end - - -module rec Typ : sig - module type PAIR = sig - type t - type t1 - type t2 - val eq: (t, t1 * t2) TypEq.t - val t1: t1 Typ.typ - val t2: t2 Typ.typ - end - - type 'a typ = - | Int of ('a, int) TypEq.t - | String of ('a, string) TypEq.t - | Pair of (module PAIR with type t = 'a) -end = struct - module type PAIR = sig - type t - type t1 - type t2 - val eq: (t, t1 * t2) TypEq.t - val t1: t1 Typ.typ - val t2: t2 Typ.typ - end - - type 'a typ = - | Int of ('a, int) TypEq.t - | String of ('a, string) TypEq.t - | Pair of (module PAIR with type t = 'a) -end - -open Typ - -let int = Int TypEq.refl - -let str = String TypEq.refl - -let pair (type s1) (type s2) t1 t2 = - let module P = struct - type t = s1 * s2 - type t1 = s1 - type t2 = s2 - let eq = TypEq.refl - let t1 = t1 - let t2 = t2 - end in - let pair = (module P : PAIR with type t = s1 * s2) in - Pair pair - -module rec Print : sig - val to_string: 'a Typ.typ -> 'a -> string -end = struct - let to_string (type s) t x = - match t with - | Int eq -> string_of_int (TypEq.apply eq x) - | String eq -> Printf.sprintf "%S" (TypEq.apply eq x) - | Pair p -> - let module P = (val p : PAIR with type t = s) in - let (x1, x2) = TypEq.apply P.eq x in - Printf.sprintf "(%s,%s)" (Print.to_string P.t1 x1) - (Print.to_string P.t2 x2) -end - -let () = - print_endline (Print.to_string int 10); - print_endline (Print.to_string (pair int (pair str int)) (123, ("A", 456))) - - -(* #6262: first-class modules and module type aliases *) - -module type S1 = sig end -module type S2 = S1 - -let _f (x : (module S1)) : (module S2) = x - -module X = struct - module type S -end -module Y = struct include X end - -let _f (x : (module X.S)) : (module Y.S) = x - -(* PR#6194, main example *) -module type S3 = sig val x : bool end;; -let f = function - | Some (module M : S3) when M.x ->1 - | Some _ [@foooo]-> 2 - | None -> 3 -;; -print_endline (string_of_int (f (Some (module struct let x = false end))));; -type 'a ty = - | Int : int ty - | Bool : bool ty - -let fbool (type t) (x : t) (tag : t ty) = - match tag with - | Bool -> x -;; -(* val fbool : 'a -> 'a ty -> 'a = <fun> *) - -(** OK: the return value is x of type t **) - -let fint (type t) (x : t) (tag : t ty) = - match tag with - | Int -> x > 0 -;; -(* val fint : 'a -> 'a ty -> bool = <fun> *) - -(** OK: the return value is x > 0 of type bool; -This has used the equation t = bool, not visible in the return type **) - -let f (type t) (x : t) (tag : t ty) = - match tag with - | Int -> x > 0 - | Bool -> x -(* val f : 'a -> 'a ty -> bool = <fun> *) - - -let g (type t) (x : t) (tag : t ty) = - match tag with - | Bool -> x - | Int -> x > 0 -(* Error: This expression has type bool but an expression was expected of type -t = int *) - -let id x = x;; -let idb1 = (fun id -> let _ = id true in id) id;; -let idb2 : bool -> bool = id;; -let idb3 ( _ : bool ) = false;; - -let g (type t) (x : t) (tag : t ty) = - match tag with - | Bool -> idb3 x - | Int -> x > 0 - -let g (type t) (x : t) (tag : t ty) = - match tag with - | Bool -> idb2 x - | Int -> x > 0 -(* Encoding generics using GADTs *) -(* (c) Alain Frisch / Lexifi *) -(* cf. http://www.lexifi.com/blog/dynamic-types *) - -(* Basic tag *) - -type 'a ty = - | Int: int ty - | String: string ty - | List: 'a ty -> 'a list ty - | Pair: ('a ty * 'b ty) -> ('a * 'b) ty -;; - -(* Tagging data *) - -type variant = - | VInt of int - | VString of string - | VList of variant list - | VPair of variant * variant - -let rec variantize: type t. t ty -> t -> variant = - fun ty x -> - (* type t is abstract here *) - match ty with - | Int -> VInt x (* in this branch: t = int *) - | String -> VString x (* t = string *) - | List ty1 -> - VList (List.map (variantize ty1) x) - (* t = 'a list for some 'a *) - | Pair (ty1, ty2) -> - VPair (variantize ty1 (fst x), variantize ty2 (snd x)) - (* t = ('a, 'b) for some 'a and 'b *) - -exception VariantMismatch - -let rec devariantize: type t. t ty -> variant -> t = - fun ty v -> - match ty, v with - | Int, VInt x -> x - | String, VString x -> x - | List ty1, VList vl -> - List.map (devariantize ty1) vl - | Pair (ty1, ty2), VPair (x1, x2) -> - (devariantize ty1 x1, devariantize ty2 x2) - | _ -> raise VariantMismatch -;; - -(* Handling records *) - -type 'a ty = - | Int: int ty - | String: string ty - | List: 'a ty -> 'a list ty - | Pair: ('a ty * 'b ty) -> ('a * 'b) ty - | Record: 'a record -> 'a ty - -and 'a record = - { - path: string; - fields: 'a field_ list; - } - -and 'a field_ = - | Field: ('a, 'b) field -> 'a field_ - -and ('a, 'b) field = - { - label: string; - field_type: 'b ty; - get: ('a -> 'b); - } -;; - -(* Again *) - -type variant = - | VInt of int - | VString of string - | VList of variant list - | VPair of variant * variant - | VRecord of (string * variant) list - -let rec variantize: type t. t ty -> t -> variant = - fun ty x -> - (* type t is abstract here *) - match ty with - | Int -> VInt x (* in this branch: t = int *) - | String -> VString x (* t = string *) - | List ty1 -> - VList (List.map (variantize ty1) x) - (* t = 'a list for some 'a *) - | Pair (ty1, ty2) -> - VPair (variantize ty1 (fst x), variantize ty2 (snd x)) - (* t = ('a, 'b) for some 'a and 'b *) - | Record {fields} -> - VRecord - (List.map (fun (Field{field_type; label; get}) -> - (label, variantize field_type (get x))) fields) -;; - -(* Extraction *) - -type 'a ty = - | Int: int ty - | String: string ty - | List: 'a ty -> 'a list ty - | Pair: ('a ty * 'b ty) -> ('a * 'b) ty - | Record: ('a, 'builder) record -> 'a ty - -and ('a, 'builder) record = - { - path: string; - fields: ('a, 'builder) field list; - create_builder: (unit -> 'builder); - of_builder: ('builder -> 'a); - } - -and ('a, 'builder) field = - | Field: ('a, 'builder, 'b) field_ -> ('a, 'builder) field - -and ('a, 'builder, 'b) field_ = - { - label: string; - field_type: 'b ty; - get: ('a -> 'b); - set: ('builder -> 'b -> unit); - } - -let rec devariantize: type t. t ty -> variant -> t = - fun ty v -> - match ty, v with - | Int, VInt x -> x - | String, VString x -> x - | List ty1, VList vl -> - List.map (devariantize ty1) vl - | Pair (ty1, ty2), VPair (x1, x2) -> - (devariantize ty1 x1, devariantize ty2 x2) - | Record {fields; create_builder; of_builder}, VRecord fl -> - if List.length fields <> List.length fl then raise VariantMismatch; - let builder = create_builder () in - List.iter2 - (fun (Field {label; field_type; set}) (lab, v) -> - if label <> lab then raise VariantMismatch; - set builder (devariantize field_type v) - ) - fields fl; - of_builder builder - | _ -> raise VariantMismatch -;; - -type my_record = - { - a: int; - b: string list; - } - -let my_record = - let fields = - [ - Field {label = "a"; field_type = Int; - get = (fun {a} -> a); - set = (fun (r, _) x -> r := Some x)}; - Field {label = "b"; field_type = List String; - get = (fun {b} -> b); - set = (fun (_, r) x -> r := Some x)}; - ] - in - let create_builder () = (ref None, ref None) in - let of_builder (a, b) = - match !a, !b with - | Some a, Some b -> {a; b} - | _ -> failwith "Some fields are missing in record of type my_record" - in - Record {path = "My_module.my_record"; fields; create_builder; of_builder} -;; - -(* Extension to recursive types and polymorphic variants *) -(* by Jacques Garrigue *) - -type noarg = Noarg - -type (_,_) ty = - | Int: (int,_) ty - | String: (string,_) ty - | List: ('a,'e) ty -> ('a list, 'e) ty - | Option: ('a,'e) ty -> ('a option, 'e) ty - | Pair: (('a,'e) ty * ('b,'e) ty) -> ('a * 'b,'e) ty - (* Support for type variables and recursive types *) - | Var: ('a, 'a -> 'e) ty - | Rec: ('a, 'a -> 'e) ty -> ('a,'e) ty - | Pop: ('a, 'e) ty -> ('a, 'b -> 'e) ty - (* Change the representation of a type *) - | Conv: string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty - (* Sum types (both normal sums and polymorphic variants) *) - | Sum: ('a, 'e, 'b) ty_sum -> ('a, 'e) ty - -and ('a, 'e, 'b) ty_sum = - { sum_proj: 'a -> string * 'e ty_dyn option; - sum_cases: (string * ('e,'b) ty_case) list; - sum_inj: 'c. ('b,'c) ty_sel * 'c -> 'a; } - -and 'e ty_dyn = (* dynamic type *) - | Tdyn : ('a,'e) ty * 'a -> 'e ty_dyn - -and (_,_) ty_sel = (* selector from a list of types *) - | Thd : ('a -> 'b, 'a) ty_sel - | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel - -and (_,_) ty_case = (* type a sum case *) - | TCarg : ('b,'a) ty_sel * ('a,'e) ty -> ('e,'b) ty_case - | TCnoarg : ('b,noarg) ty_sel -> ('e,'b) ty_case -;; - -type _ ty_env = (* type variable substitution *) - | Enil : unit ty_env - | Econs : ('a,'e) ty * 'e ty_env -> ('a -> 'e) ty_env -;; - -(* Comparing selectors *) -type (_,_) eq = Eq: ('a,'a) eq - -let rec eq_sel : type a b c. (a,b) ty_sel -> (a,c) ty_sel -> (b,c) eq option = - fun s1 s2 -> - match s1, s2 with - | Thd, Thd -> Some Eq - | Ttl s1, Ttl s2 -> - (match eq_sel s1 s2 with None -> None | Some Eq -> Some Eq) - | _ -> None - -(* Auxiliary function to get the type of a case from its selector *) -let rec get_case : type a b e. - (b, a) ty_sel -> (string * (e,b) ty_case) list -> string * (a, e) ty option = - fun sel cases -> - match cases with - | (name, TCnoarg sel') :: rem -> - begin match eq_sel sel sel' with - | None -> get_case sel rem - | Some Eq -> name, None - end - | (name, TCarg (sel', ty)) :: rem -> - begin match eq_sel sel sel' with - | None -> get_case sel rem - | Some Eq -> name, Some ty - end - | [] -> raise Not_found -;; - -(* Untyped representation of values *) -type variant = - | VInt of int - | VString of string - | VList of variant list - | VOption of variant option - | VPair of variant * variant - | VConv of string * variant - | VSum of string * variant option - -let may_map f = function Some x -> Some (f x) | None -> None - -let rec variantize : type a e. e ty_env -> (a,e) ty -> a -> variant = - fun e ty v -> - match ty with - | Int -> VInt v - | String -> VString v - | List t -> VList (List.map (variantize e t) v) - | Option t -> VOption (may_map (variantize e t) v) - | Pair (t1, t2) -> VPair (variantize e t1 (fst v), variantize e t2 (snd v)) - | Rec t -> variantize (Econs (ty, e)) t v - | Pop t -> (match e with Econs (_, e') -> variantize e' t v) - | Var -> (match e with Econs (t, e') -> variantize e' t v) - | Conv (s, proj, inj, t) -> VConv (s, variantize e t (proj v)) - | Sum ops -> - let tag, arg = ops.sum_proj v in - VSum (tag, may_map (function Tdyn (ty,arg) -> variantize e ty arg) arg) -;; - -let rec devariantize : type t e. e ty_env -> (t, e) ty -> variant -> t = - fun e ty v -> - match ty, v with - | Int, VInt x -> x - | String, VString x -> x - | List ty1, VList vl -> - List.map (devariantize e ty1) vl - | Pair (ty1, ty2), VPair (x1, x2) -> - (devariantize e ty1 x1, devariantize e ty2 x2) - | Rec t, _ -> devariantize (Econs (ty, e)) t v - | Pop t, _ -> (match e with Econs (_, e') -> devariantize e' t v) - | Var, _ -> (match e with Econs (t, e') -> devariantize e' t v) - | Conv (s, proj, inj, t), VConv (s', v) when s = s' -> - inj (devariantize e t v) - | Sum ops, VSum (tag, a) -> - begin try match List.assoc tag ops.sum_cases, a with - | TCarg (sel, t), Some a -> ops.sum_inj (sel, devariantize e t a) - | TCnoarg sel, None -> ops.sum_inj (sel, Noarg) - | _ -> raise VariantMismatch - with Not_found -> raise VariantMismatch - end - | _ -> raise VariantMismatch -;; - -(* First attempt: represent 1-constructor variants using Conv *) -let wrap_A t = Conv ("`A", (fun (`A x) -> x), (fun x -> `A x), t);; - -let ty a = Rec (wrap_A (Option (Pair (a, Var)))) ;; -let v = variantize Enil (ty Int);; -let x = v (`A (Some (1, `A (Some (2, `A None))))) ;; - -(* Can also use it to decompose a tuple *) - -let triple t1 t2 t3 = - Conv ("Triple", (fun (a,b,c) -> (a,(b,c))), - (fun (a,(b,c)) -> (a,b,c)), Pair (t1, Pair (t2, t3))) - -let v = variantize Enil (triple String Int Int) ("A", 2, 3) ;; - -(* Second attempt: introduce a real sum construct *) -let ty_abc = - (* Could also use [get_case] for proj, but direct definition is shorter *) - let proj = function - `A n -> "A", Some (Tdyn (Int, n)) - | `B s -> "B", Some (Tdyn (String, s)) - | `C -> "C", None - (* Define inj in advance to be able to write the type annotation easily *) - and inj : type c. (int -> string -> noarg -> unit, c) ty_sel * c -> - [`A of int | `B of string | `C] = function - Thd, v -> `A v - | Ttl Thd, v -> `B v - | Ttl (Ttl Thd), Noarg -> `C - in - (* Coherence of sum_inj and sum_cases is checked by the typing *) - Sum { sum_proj = proj; sum_inj = inj; sum_cases = - [ "A", TCarg (Thd, Int); "B", TCarg (Ttl Thd, String); - "C", TCnoarg (Ttl (Ttl Thd)) ] } -;; - -let v = variantize Enil ty_abc (`A 3) -let a = devariantize Enil ty_abc v - -(* And an example with recursion... *) -type 'a vlist = [`Nil | `Cons of 'a * 'a vlist] - -let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = fun t -> - let tcons = Pair (Pop t, Var) in - Rec (Sum { - sum_proj = (function - `Nil -> "Nil", None - | `Cons p -> "Cons", Some (Tdyn (tcons, p))); - sum_cases = ["Nil", TCnoarg Thd; "Cons", TCarg (Ttl Thd, tcons)]; - sum_inj = fun (type c) -> - (function - | Thd, Noarg -> `Nil - | Ttl Thd, v -> `Cons v - : (noarg -> a * a vlist -> unit, c) ty_sel * c -> a vlist) - (* One can also write the type annotation directly *) - }) - -let v = variantize Enil (ty_list Int) (`Cons (1, `Cons (2, `Nil))) ;; - - -(* Simpler but weaker approach *) - -type (_,_) ty = - | Int: (int,_) ty - | String: (string,_) ty - | List: ('a,'e) ty -> ('a list, 'e) ty - | Option: ('a,'e) ty -> ('a option, 'e) ty - | Pair: (('a,'e) ty * ('b,'e) ty) -> ('a * 'b,'e) ty - | Var: ('a, 'a -> 'e) ty - | Rec: ('a, 'a -> 'e) ty -> ('a,'e) ty - | Pop: ('a, 'e) ty -> ('a, 'b -> 'e) ty - | Conv: string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty - | Sum: ('a -> string * 'e ty_dyn option) * (string * 'e ty_dyn option -> 'a) - -> ('a, 'e) ty -and 'e ty_dyn = - | Tdyn : ('a,'e) ty * 'a -> 'e ty_dyn - -let ty_abc : ([`A of int | `B of string | `C],'e) ty = - (* Could also use [get_case] for proj, but direct definition is shorter *) - Sum ( - (function - `A n -> "A", Some (Tdyn (Int, n)) - | `B s -> "B", Some (Tdyn (String, s)) - | `C -> "C", None), - (function - "A", Some (Tdyn (Int, n)) -> `A n - | "B", Some (Tdyn (String, s)) -> `B s - | "C", None -> `C - | _ -> invalid_arg "ty_abc")) -;; - -(* Breaks: no way to pattern-match on a full recursive type *) -let ty_list : type a e. (a,e) ty -> (a vlist,e) ty = fun t -> - let targ = Pair (Pop t, Var) in - Rec (Sum ( - (function `Nil -> "Nil", None - | `Cons p -> "Cons", Some (Tdyn (targ, p))), - (function "Nil", None -> `Nil - | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> `Cons p))) -;; - -(* Define Sum using object instead of record for first-class polymorphism *) - -type (_,_) ty = - | Int: (int,_) ty - | String: (string,_) ty - | List: ('a,'e) ty -> ('a list, 'e) ty - | Option: ('a,'e) ty -> ('a option, 'e) ty - | Pair: (('a,'e) ty * ('b,'e) ty) -> ('a * 'b,'e) ty - | Var: ('a, 'a -> 'e) ty - | Rec: ('a, 'a -> 'e) ty -> ('a,'e) ty - | Pop: ('a, 'e) ty -> ('a, 'b -> 'e) ty - | Conv: string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty - | Sum: < proj: 'a -> string * 'e ty_dyn option; - cases: (string * ('e,'b) ty_case) list; - inj: 'c. ('b,'c) ty_sel * 'c -> 'a > - -> ('a, 'e) ty - -and 'e ty_dyn = - | Tdyn : ('a,'e) ty * 'a -> 'e ty_dyn - -and (_,_) ty_sel = - | Thd : ('a -> 'b, 'a) ty_sel - | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel - -and (_,_) ty_case = - | TCarg : ('b,'a) ty_sel * ('a,'e) ty -> ('e,'b) ty_case - | TCnoarg : ('b,noarg) ty_sel -> ('e,'b) ty_case -;; - -let ty_abc : ([`A of int | `B of string | `C] as 'a, 'e) ty = - Sum (object - method proj = function - `A n -> "A", Some (Tdyn (Int, n)) - | `B s -> "B", Some (Tdyn (String, s)) - | `C -> "C", None - method cases = - [ "A", TCarg (Thd, Int); "B", TCarg (Ttl Thd, String); - "C", TCnoarg (Ttl (Ttl Thd)) ]; - method inj : type c. - (int -> string -> noarg -> unit, c) ty_sel * c -> - [`A of int | `B of string | `C] = - function - Thd, v -> `A v - | Ttl Thd, v -> `B v - | Ttl (Ttl Thd), Noarg -> `C - end) - -type 'a vlist = [`Nil | `Cons of 'a * 'a vlist] - -let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = fun t -> - let tcons = Pair (Pop t, Var) in - Rec (Sum (object - method proj = function - `Nil -> "Nil", None - | `Cons p -> "Cons", Some (Tdyn (tcons, p)) - method cases = ["Nil", TCnoarg Thd; "Cons", TCarg (Ttl Thd, tcons)] - method inj : type c.(noarg -> a * a vlist -> unit, c) ty_sel * c -> a vlist - = function - | Thd, Noarg -> `Nil - | Ttl Thd, v -> `Cons v - end)) -;; - -(* -type (_,_) ty_assoc = - | Anil : (unit,'e) ty_assoc - | Acons : string * ('a,'e) ty * ('b,'e) ty_assoc -> ('a -> 'b, 'e) ty_assoc - -and (_,_) ty_pvar = - | Pnil : ('a,'e) ty_pvar - | Pconst : 't * ('b,'e) ty_pvar -> ('t -> 'b, 'e) ty_pvar - | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar -*) -(* - An attempt at encoding omega examples from the 2nd Central European - Functional Programming School: - Generic Programming in Omega, by Tim Sheard and Nathan Linger - http://web.cecs.pdx.edu/~sheard/ -*) - -(* Basic types *) - -type ('a,'b) sum = Inl of 'a | Inr of 'b - -type zero = Zero -type 'a succ = Succ of 'a -type _ nat = - | NZ : zero nat - | NS : 'a nat -> 'a succ nat -;; - -(* 2: A simple example *) - -type (_,_) seq = - | Snil : ('a,zero) seq - | Scons : 'a * ('a,'n) seq -> ('a, 'n succ) seq -;; - -let l1 = Scons (3, Scons (5, Snil)) ;; - -(* We do not have type level functions, so we need to use witnesses. *) -(* We copy here the definitions from section 3.9 *) -(* Note the addition of the ['a nat] argument to PlusZ, since we do not - have kinds *) -type (_,_,_) plus = - | PlusZ : 'a nat -> (zero, 'a, 'a) plus - | PlusS : ('a,'b,'c) plus -> ('a succ, 'b, 'c succ) plus -;; - -let rec length : type a n. (a,n) seq -> n nat = function - | Snil -> NZ - | Scons (_, s) -> NS (length s) -;; - -(* app returns the catenated lists with a witness proving that - the size is the sum of its two inputs *) -type (_,_,_) app = App : ('a,'p) seq * ('n,'m,'p) plus -> ('a,'n,'m) app - -let rec app : type a n m. (a,n) seq -> (a,m) seq -> (a,n,m) app = - fun xs ys -> - match xs with - | Snil -> App (ys, PlusZ (length ys)) - | Scons (x, xs') -> - let App (xs'', pl) = app xs' ys in - App (Scons (x, xs''), PlusS pl) -;; - -(* 3.1 Feature: kinds *) - -(* We do not have kinds, but we can encode them as predicates *) - -type tp = TP -type nd = ND -type ('a,'b) fk = FK -type _ shape = - | Tp : tp shape - | Nd : nd shape - | Fk : 'a shape * 'b shape -> ('a,'b) fk shape -;; -type tt = TT -type ff = FF -type _ boolean = - | BT : tt boolean - | BF : ff boolean -;; - -(* 3.3 Feature : GADTs *) - -type (_,_) path = - | Pnone : 'a -> (tp,'a) path - | Phere : (nd,'a) path - | Pleft : ('x,'a) path -> (('x,'y) fk, 'a) path - | Pright : ('y,'a) path -> (('x,'y) fk, 'a) path -;; -type (_,_) tree = - | Ttip : (tp,'a) tree - | Tnode : 'a -> (nd,'a) tree - | Tfork : ('x,'a) tree * ('y,'a) tree -> (('x,'y)fk, 'a) tree -;; -let tree1 = Tfork (Tfork (Ttip, Tnode 4), Tfork (Tnode 4, Tnode 3)) -;; -let rec find : type sh. - ('a -> 'a -> bool) -> 'a -> (sh,'a) tree -> (sh,'a) path list - = fun eq n t -> - match t with - | Ttip -> [] - | Tnode m -> - if eq n m then [Phere] else [] - | Tfork (x, y) -> - List.map (fun x -> Pleft x) (find eq n x) @ - List.map (fun x -> Pright x) (find eq n y) -;; -let rec extract : type sh. (sh,'a) path -> (sh,'a) tree -> 'a = fun p t -> - match (p, t) with - | Pnone x, Ttip -> x - | Phere, Tnode y -> y - | Pleft p, Tfork(l,_) -> extract p l - | Pright p, Tfork(_,r) -> extract p r -;; - -(* 3.4 Pattern : Witness *) - -type (_,_) le = - | LeZ : 'a nat -> (zero, 'a) le - | LeS : ('n, 'm) le -> ('n succ, 'm succ) le -;; -type _ even = - | EvenZ : zero even - | EvenSS : 'n even -> 'n succ succ even -;; -type one = zero succ -type two = one succ -type three = two succ -type four = three succ -;; -let even0 : zero even = EvenZ -let even2 : two even = EvenSS EvenZ -let even4 : four even = EvenSS (EvenSS EvenZ) -;; -let p1 : (two, one, three) plus = PlusS (PlusS (PlusZ (NS NZ))) -;; -let rec summandLessThanSum : type a b c. (a,b,c) plus -> (a,c) le = fun p -> - match p with - | PlusZ n -> LeZ n - | PlusS p' -> LeS (summandLessThanSum p') -;; - -(* 3.8 Pattern: Leibniz Equality *) - -type (_,_) equal = Eq : ('a,'a) equal - -let convert : type a b. (a,b) equal -> a -> b = fun Eq x -> x - -let rec sameNat : type a b. a nat -> b nat -> (a,b) equal option = fun a b -> - match a, b with - | NZ, NZ -> Some Eq - | NS a', NS b' -> - begin match sameNat a' b' with - | Some Eq -> Some Eq - | None -> None - end - | _ -> None -;; - -(* Extra: associativity of addition *) - -let rec plus_func : type a b m n. - (a,b,m) plus -> (a,b,n) plus -> (m,n) equal = - fun p1 p2 -> - match p1, p2 with - | PlusZ _, PlusZ _ -> Eq - | PlusS p1', PlusS p2' -> - let Eq = plus_func p1' p2' in Eq - -let rec plus_assoc : type a b c ab bc m n. - (a,b,ab) plus -> (ab,c,m) plus -> - (b,c,bc) plus -> (a,bc,n) plus -> (m,n) equal = fun p1 p2 p3 p4 -> - match p1, p4 with - | PlusZ b, PlusZ bc -> - let Eq = plus_func p2 p3 in Eq - | PlusS p1', PlusS p4' -> - let PlusS p2' = p2 in - let Eq = plus_assoc p1' p2' p3 p4' in Eq -;; - -(* 3.9 Computing Programs and Properties Simultaneously *) - -(* Plus and app1 are moved to section 2 *) - -let smaller : type a b. (a succ, b succ) le -> (a,b) le = - function LeS x -> x ;; - -type (_,_) diff = Diff : 'c nat * ('a,'c,'b) plus -> ('a,'b) diff ;; - -(* -let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff = - fun le a b -> - match a, b, le with - | NZ, m, _ -> Diff (m, PlusZ m) - | NS x, NZ, _ -> assert false - | NS x, NS y, q -> - match diff (smaller q) x y with Diff (m, p) -> Diff (m, PlusS p) -;; -*) - -let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff = - fun le a b -> - match le, a, b with - | LeZ _, _, m -> Diff (m, PlusZ m) - | LeS q, NS x, NS y -> - match diff q x y with Diff (m, p) -> Diff (m, PlusS p) -;; - -let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff = - fun le a b -> - match a, b,le with (* warning *) - | NZ, m, LeZ _ -> Diff (m, PlusZ m) - | NS x, NS y, LeS q -> - (match diff q x y with Diff (m, p) -> Diff (m, PlusS p)) - | _ -> . -;; - -let rec diff : type a b. (a,b) le -> b nat -> (a,b) diff = - fun le b -> - match b,le with - | m, LeZ _ -> Diff (m, PlusZ m) - | NS y, LeS q -> - match diff q y with Diff (m, p) -> Diff (m, PlusS p) -;; - -type (_,_) filter = Filter : ('m,'n) le * ('a,'m) seq -> ('a,'n) filter - -let rec leS' : type m n. (m,n) le -> (m,n succ) le = function - | LeZ n -> LeZ (NS n) - | LeS le -> LeS (leS' le) -;; - -let rec filter : type a n. (a -> bool) -> (a,n) seq -> (a,n) filter = - fun f s -> - match s with - | Snil -> Filter (LeZ NZ, Snil) - | Scons (a,l) -> - match filter f l with Filter (le, l') -> - if f a then Filter (LeS le, Scons (a, l')) - else Filter (leS' le, l') -;; - -(* 4.1 AVL trees *) - -type (_,_,_) balance = - | Less : ('h, 'h succ, 'h succ) balance - | Same : ('h, 'h, 'h) balance - | More : ('h succ, 'h, 'h succ) balance - -type _ avl = - | Leaf : zero avl - | Node : - ('hL, 'hR, 'hMax) balance * 'hL avl * int * 'hR avl -> 'hMax succ avl - -type avl' = Avl : 'h avl -> avl' -;; - -let empty = Avl Leaf - -let rec elem : type h. int -> h avl -> bool = fun x t -> - match t with - | Leaf -> false - | Node (_, l, y, r) -> - x = y || if x < y then elem x l else elem x r -;; - -let rec rotr : type n. (n succ succ) avl -> int -> n avl -> - ((n succ succ) avl, (n succ succ succ) avl) sum = - fun tL y tR -> - match tL with - | Node (Same, a, x, b) -> Inr (Node (Less, a, x, Node (More, b, y, tR))) - | Node (More, a, x, b) -> Inl (Node (Same, a, x, Node (Same, b, y, tR))) - | Node (Less, a, x, Node (Same, b, z, c)) -> - Inl (Node (Same, Node (Same, a, x, b), z, Node (Same, c, y, tR))) - | Node (Less, a, x, Node (Less, b, z, c)) -> - Inl (Node (Same, Node (More, a, x, b), z, Node (Same, c, y, tR))) - | Node (Less, a, x, Node (More, b, z, c)) -> - Inl (Node (Same, Node (Same, a, x, b), z, Node (Less, c, y, tR))) -;; -let rec rotl : type n. n avl -> int -> (n succ succ) avl -> - ((n succ succ) avl, (n succ succ succ) avl) sum = - fun tL u tR -> - match tR with - | Node (Same, a, x, b) -> Inr (Node (More, Node (Less, tL, u, a), x, b)) - | Node (Less, a, x, b) -> Inl (Node (Same, Node (Same, tL, u, a), x, b)) - | Node (More, Node (Same, a, x, b), y, c) -> - Inl (Node (Same, Node (Same, tL, u, a), x, Node (Same, b, y, c))) - | Node (More, Node (Less, a, x, b), y, c) -> - Inl (Node (Same, Node (More, tL, u, a), x, Node (Same, b, y, c))) - | Node (More, Node (More, a, x, b), y, c) -> - Inl (Node (Same, Node (Same, tL, u, a), x, Node (Less, b, y, c))) -;; -let rec ins : type n. int -> n avl -> (n avl, (n succ) avl) sum = - fun x t -> - match t with - | Leaf -> Inr (Node (Same, Leaf, x, Leaf)) - | Node (bal, a, y, b) -> - if x = y then Inl t else - if x < y then begin - match ins x a with - | Inl a -> Inl (Node (bal, a, y, b)) - | Inr a -> - match bal with - | Less -> Inl (Node (Same, a, y, b)) - | Same -> Inr (Node (More, a, y, b)) - | More -> rotr a y b - end else begin - match ins x b with - | Inl b -> Inl (Node (bal, a, y, b) : n avl) - | Inr b -> - match bal with - | More -> Inl (Node (Same, a, y, b) : n avl) - | Same -> Inr (Node (Less, a, y, b) : n succ avl) - | Less -> rotl a y b - end -;; - -let insert x (Avl t) = - match ins x t with - | Inl t -> Avl t - | Inr t -> Avl t -;; - -let rec del_min : type n. (n succ) avl -> int * (n avl, (n succ) avl) sum = - function - | Node (Less, Leaf, x, r) -> (x, Inl r) - | Node (Same, Leaf, x, r) -> (x, Inl r) - | Node (bal, (Node _ as l) , x, r) -> - match del_min l with - | y, Inr l -> (y, Inr (Node (bal, l, x, r))) - | y, Inl l -> - (y, match bal with - | Same -> Inr (Node (Less, l, x, r)) - | More -> Inl (Node (Same, l, x, r)) - | Less -> rotl l x r) - -type _ avl_del = - | Dsame : 'n avl -> 'n avl_del - | Ddecr : ('m succ, 'n) equal * 'm avl -> 'n avl_del - -let rec del : type n. int -> n avl -> n avl_del = fun y t -> - match t with - | Leaf -> Dsame Leaf - | Node (bal, l, x, r) -> - if x = y then begin - match r with - | Leaf -> - begin match bal with - | Same -> Ddecr (Eq, l) - | More -> Ddecr (Eq, l) - end - | Node _ -> - begin match bal, del_min r with - | _, (z, Inr r) -> Dsame (Node (bal, l, z, r)) - | Same, (z, Inl r) -> Dsame (Node (More, l, z, r)) - | Less, (z, Inl r) -> Ddecr (Eq, Node (Same, l, z, r)) - | More, (z, Inl r) -> - match rotr l z r with - | Inl t -> Ddecr (Eq, t) - | Inr t -> Dsame t - end - end else if y < x then begin - match del y l with - | Dsame l -> Dsame (Node (bal, l, x, r)) - | Ddecr(Eq,l) -> - begin match bal with - | Same -> Dsame (Node (Less, l, x, r)) - | More -> Ddecr (Eq, Node (Same, l, x, r)) - | Less -> - match rotl l x r with - | Inl t -> Ddecr (Eq, t) - | Inr t -> Dsame t - end - end else begin - match del y r with - | Dsame r -> Dsame (Node (bal, l, x, r)) - | Ddecr(Eq,r) -> - begin match bal with - | Same -> Dsame (Node (More, l, x, r)) - | Less -> Ddecr (Eq, Node (Same, l, x, r)) - | More -> - match rotr l x r with - | Inl t -> Ddecr (Eq, t) - | Inr t -> Dsame t - end - end -;; - -let delete x (Avl t) = - match del x t with - | Dsame t -> Avl t - | Ddecr (_, t) -> Avl t -;; - - -(* Exercise 22: Red-black trees *) - -type red = RED -type black = BLACK -type (_,_) sub_tree = - | Bleaf : (black, zero) sub_tree - | Rnode : - (black, 'n) sub_tree * int * (black, 'n) sub_tree -> (red, 'n) sub_tree - | Bnode : - ('cL, 'n) sub_tree * int * ('cR, 'n) sub_tree -> (black, 'n succ) sub_tree - -type rb_tree = Root : (black, 'n) sub_tree -> rb_tree -;; - -type dir = LeftD | RightD - -type (_,_) ctxt = - | CNil : (black,'n) ctxt - | CRed : int * dir * (black,'n) sub_tree * (red,'n) ctxt -> (black,'n) ctxt - | CBlk : int * dir * ('c1,'n) sub_tree * (black, 'n succ) ctxt -> ('c,'n) ctxt -;; - -let blacken = function - Rnode (l, e, r) -> Bnode (l, e, r) - -type _ crep = - | Red : red crep - | Black : black crep - -let color : type c n. (c,n) sub_tree -> c crep = function - | Bleaf -> Black - | Rnode _ -> Red - | Bnode _ -> Black -;; - -let rec fill : type c n. (c,n) ctxt -> (c,n) sub_tree -> rb_tree = - fun ct t -> - match ct with - | CNil -> Root t - | CRed (e, LeftD, uncle, c) -> fill c (Rnode (uncle, e, t)) - | CRed (e, RightD, uncle, c) -> fill c (Rnode (t, e, uncle)) - | CBlk (e, LeftD, uncle, c) -> fill c (Bnode (uncle, e, t)) - | CBlk (e, RightD, uncle, c) -> fill c (Bnode (t, e, uncle)) -;; -let recolor d1 pE sib d2 gE uncle t = - match d1, d2 with - | LeftD, RightD -> Rnode (Bnode (sib, pE, t), gE, uncle) - | RightD, RightD -> Rnode (Bnode (t, pE, sib), gE, uncle) - | LeftD, LeftD -> Rnode (uncle, gE, Bnode (sib, pE, t)) - | RightD, LeftD -> Rnode (uncle, gE, Bnode (t, pE, sib)) -;; -let rotate d1 pE sib d2 gE uncle (Rnode (x, e, y)) = - match d1, d2 with - | RightD, RightD -> Bnode (Rnode (x,e,y), pE, Rnode (sib, gE, uncle)) - | LeftD, RightD -> Bnode (Rnode (sib, pE, x), e, Rnode (y, gE, uncle)) - | LeftD, LeftD -> Bnode (Rnode (uncle, gE, sib), pE, Rnode (x,e,y)) - | RightD, LeftD -> Bnode (Rnode (uncle, gE, x), e, Rnode (y, pE, sib)) -;; -let rec repair : type c n. (red,n) sub_tree -> (c,n) ctxt -> rb_tree = - fun t ct -> - match ct with - | CNil -> Root (blacken t) - | CBlk (e, LeftD, sib, c) -> fill c (Bnode (sib, e, t)) - | CBlk (e, RightD, sib, c) -> fill c (Bnode (t, e, sib)) - | CRed (e, dir, sib, CBlk (e', dir', uncle, ct)) -> - match color uncle with - | Red -> repair (recolor dir e sib dir' e' (blacken uncle) t) ct - | Black -> fill ct (rotate dir e sib dir' e' uncle t) -;; -let rec ins : type c n. int -> (c,n) sub_tree -> (c,n) ctxt -> rb_tree = - fun e t ct -> - match t with - | Rnode (l, e', r) -> - if e < e' then ins e l (CRed (e', RightD, r, ct)) - else ins e r (CRed (e', LeftD, l, ct)) - | Bnode (l, e', r) -> - if e < e' then ins e l (CBlk (e', RightD, r, ct)) - else ins e r (CBlk (e', LeftD, l, ct)) - | Bleaf -> repair (Rnode (Bleaf, e, Bleaf)) ct -;; -let insert e (Root t) = ins e t CNil -;; - -(* 5.7 typed object languages using GADTs *) - -type _ term = - | Const : int -> int term - | Add : (int * int -> int) term - | LT : (int * int -> bool) term - | Ap : ('a -> 'b) term * 'a term -> 'b term - | Pair : 'a term * 'b term -> ('a * 'b) term - -let ex1 = Ap (Add, Pair (Const 3, Const 5)) -let ex2 = Pair (ex1, Const 1) - -let rec eval_term : type a. a term -> a = function - | Const x -> x - | Add -> fun (x,y) -> x+y - | LT -> fun (x,y) -> x<y - | Ap(f,x) -> eval_term f (eval_term x) - | Pair(x,y) -> (eval_term x, eval_term y) - -type _ rep = - | Rint : int rep - | Rbool : bool rep - | Rpair : 'a rep * 'b rep -> ('a * 'b) rep - | Rfun : 'a rep * 'b rep -> ('a -> 'b) rep - -type (_,_) equal = Eq : ('a,'a) equal - -let rec rep_equal : type a b. a rep -> b rep -> (a, b) equal option = - fun ra rb -> - match ra, rb with - | Rint, Rint -> Some Eq - | Rbool, Rbool -> Some Eq - | Rpair (a1, a2), Rpair (b1, b2) -> - begin match rep_equal a1 b1 with - | None -> None - | Some Eq -> match rep_equal a2 b2 with - | None -> None - | Some Eq -> Some Eq - end - | Rfun (a1, a2), Rfun (b1, b2) -> - begin match rep_equal a1 b1 with - | None -> None - | Some Eq -> match rep_equal a2 b2 with - | None -> None - | Some Eq -> Some Eq - end - | _ -> None -;; - -type assoc = Assoc : string * 'a rep * 'a -> assoc - -let rec assoc : type a. string -> a rep -> assoc list -> a = - fun x r -> function - | [] -> raise Not_found - | Assoc (x', r', v) :: env -> - if x = x' then - match rep_equal r r' with - | None -> failwith ("Wrong type for " ^ x) - | Some Eq -> v - else assoc x r env - -type _ term = - | Var : string * 'a rep -> 'a term - | Abs : string * 'a rep * 'b term -> ('a -> 'b) term - | Const : int -> int term - | Add : (int * int -> int) term - | LT : (int * int -> bool) term - | Ap : ('a -> 'b) term * 'a term -> 'b term - | Pair : 'a term * 'b term -> ('a * 'b) term - -let rec eval_term : type a. assoc list -> a term -> a = - fun env -> function - | Var (x, r) -> assoc x r env - | Abs (x, r, e) -> fun v -> eval_term (Assoc (x, r, v) :: env) e - | Const x -> x - | Add -> fun (x,y) -> x+y - | LT -> fun (x,y) -> x<y - | Ap(f,x) -> eval_term env f (eval_term env x) - | Pair(x,y) -> (eval_term env x, eval_term env y) -;; - -let ex3 = Abs ("x", Rint, Ap (Add, Pair (Var("x",Rint), Var("x",Rint)))) -let ex4 = Ap (ex3, Const 3) - -let v4 = eval_term [] ex4 -;; - -(* 5.9/5.10 Language with binding *) - -type rnil = RNIL -type ('a,'b,'c) rcons = RCons of 'a * 'b * 'c - -type _ is_row = - | Rnil : rnil is_row - | Rcons : 'c is_row -> ('a,'b,'c) rcons is_row - -type (_,_) lam = - | Const : int -> ('e, int) lam - | Var : 'a -> (('a,'t,'e) rcons, 't) lam - | Shift : ('e,'t) lam -> (('a,'q,'e) rcons, 't) lam - | Abs : 'a * (('a,'s,'e) rcons, 't) lam -> ('e, 's -> 't) lam - | App : ('e, 's -> 't) lam * ('e, 's) lam -> ('e, 't) lam - -type x = X -type y = Y - -let ex1 = App (Var X, Shift (Var Y)) -let ex2 = Abs (X, Abs (Y, App (Shift (Var X), Var Y))) -;; - -type _ env = - | Enil : rnil env - | Econs : 'a * 't * 'e env -> ('a, 't, 'e) rcons env - -let rec eval_lam : type e t. e env -> (e, t) lam -> t = - fun env m -> - match env, m with - | _, Const n -> n - | Econs (_, v, r), Var _ -> v - | Econs (_, _, r), Shift e -> eval_lam r e - | _, Abs (n, body) -> fun x -> eval_lam (Econs (n, x, env)) body - | _, App (f, x) -> eval_lam env f (eval_lam env x) -;; - -type add = Add -type suc = Suc - -let env0 = Econs (Zero, 0, Econs (Suc, succ, Econs (Add, (+), Enil))) - -let _0 : (_, int) lam = Var Zero -let suc x = App (Shift (Var Suc : (_, int -> int) lam), x) -let _1 = suc _0 -let _2 = suc _1 -let _3 = suc _2 -let add = Shift (Shift (Var Add : (_, int -> int -> int) lam)) - -let double = Abs (X, App (App (Shift add, Var X), Var X)) -let ex3 = App (double, _3) -;; - -let v3 = eval_lam env0 ex3 -;; - -(* 5.13: Constructing typing derivations at runtime *) - -(* Modified slightly to use the language of 5.10, since this is more fun. - Of course this works also with the language of 5.12. *) - -type _ rep = - | I : int rep - | Ar : 'a rep * 'b rep -> ('a -> 'b) rep - -let rec compare : type a b. a rep -> b rep -> (string, (a,b) equal) sum = - fun a b -> - match a, b with - | I, I -> Inr Eq - | Ar(x,y), Ar(s,t) -> - begin match compare x s with - | Inl _ as e -> e - | Inr Eq -> match compare y t with - | Inl _ as e -> e - | Inr Eq as e -> e - end - | I, Ar _ -> Inl "I <> Ar _" - | Ar _, I -> Inl "Ar _ <> I" -;; - -type term = - | C of int - | Ab : string * 'a rep * term -> term - | Ap of term * term - | V of string - -type _ ctx = - | Cnil : rnil ctx - | Ccons : 't * string * 'x rep * 'e ctx -> ('t,'x,'e) rcons ctx -;; - -type _ checked = - | Cerror of string - | Cok : ('e,'t) lam * 't rep -> 'e checked - -let rec lookup : type e. string -> e ctx -> e checked = - fun name ctx -> - match ctx with - | Cnil -> Cerror ("Name not found: " ^ name) - | Ccons (l,s,t,rs) -> - if s = name then Cok (Var l,t) else - match lookup name rs with - | Cerror m -> Cerror m - | Cok (v, t) -> Cok (Shift v, t) -;; - -let rec tc : type n e. n nat -> e ctx -> term -> e checked = - fun n ctx t -> - match t with - | V s -> lookup s ctx - | Ap(f,x) -> - begin match tc n ctx f with - | Cerror _ as e -> e - | Cok (f', ft) -> match tc n ctx x with - | Cerror _ as e -> e - | Cok (x', xt) -> - match ft with - | Ar (a, b) -> - begin match compare a xt with - | Inl s -> Cerror s - | Inr Eq -> Cok (App (f',x'), b) - end - | _ -> Cerror "Non fun in Ap" - end - | Ab(s,t,body) -> - begin match tc (NS n) (Ccons (n, s, t, ctx)) body with - | Cerror _ as e -> e - | Cok (body', et) -> Cok (Abs (n, body'), Ar (t, et)) - end - | C m -> Cok (Const m, I) -;; - -let ctx0 = - Ccons (Zero, "0", I, - Ccons (Suc, "S", Ar(I,I), - Ccons (Add, "+", Ar(I,Ar(I,I)), Cnil))) - -let ex1 = Ab ("x", I, Ap(Ap(V"+",V"x"),V"x"));; -let c1 = tc NZ ctx0 ex1;; -let ex2 = Ap (ex1, C 3);; -let c2 = tc NZ ctx0 ex2;; - -let eval_checked env = function - | Cerror s -> failwith s - | Cok (e, I) -> (eval_lam env e : int) - | Cok _ -> failwith "Can only evaluate expressions of type I" -;; - -let v2 = eval_checked env0 c2 ;; - -(* 5.12 Soundness *) - -type pexp = PEXP -type pval = PVAL -type _ mode = - | Pexp : pexp mode - | Pval : pval mode - -type ('a,'b) tarr = TARR -type tint = TINT - -type (_,_) rel = - | IntR : (tint, int) rel - | IntTo : ('b, 's) rel -> ((tint, 'b) tarr, int -> 's) rel - -type (_,_,_) lam = - | Const : ('a,'b) rel * 'b -> (pval, 'env, 'a) lam - | Var : 'a -> (pval, ('a,'t,'e) rcons, 't) lam - | Shift : ('m,'e,'t) lam -> ('m, ('a,'q,'e) rcons, 't) lam - | Lam : 'a * ('m, ('a,'s,'e) rcons, 't) lam -> (pval, 'e, ('s,'t) tarr) lam - | App : ('m1, 'e, ('s,'t) tarr) lam * ('m2, 'e, 's) lam -> (pexp, 'e, 't) lam -;; - -let ex1 = App (Lam (X, Var X), Const (IntR, 3)) - -let rec mode : type m e t. (m,e,t) lam -> m mode = function - | Lam (v, body) -> Pval - | Var v -> Pval - | Const (r, v) -> Pval - | Shift e -> mode e - | App _ -> Pexp -;; - -type (_,_) sub = - | Id : ('r,'r) sub - | Bind : 't * ('m,'r2,'x) lam * ('r,'r2) sub -> (('t,'x,'r) rcons, 'r2) sub - | Push : ('r1,'r2) sub -> (('a,'b,'r1) rcons, ('a,'b,'r2) rcons) sub - -type (_,_) lam' = Ex : ('m, 's, 't) lam -> ('s,'t) lam' -;; - -let rec subst : type m1 r t s. (m1,r,t) lam -> (r,s) sub -> (s,t) lam' = - fun t s -> - match t, s with - | _, Id -> Ex t - | Const(r,c), sub -> Ex (Const (r,c)) - | Var v, Bind (x, e, r) -> Ex e - | Var v, Push sub -> Ex (Var v) - | Shift e, Bind (_, _, r) -> subst e r - | Shift e, Push sub -> - (match subst e sub with Ex a -> Ex (Shift a)) - | App(f,x), sub -> - (match subst f sub, subst x sub with Ex g, Ex y -> Ex (App (g,y))) - | Lam(v,x), sub -> - (match subst x (Push sub) with Ex body -> Ex (Lam (v, body))) -;; - -type closed = rnil - -type 'a rlam = ((pexp,closed,'a) lam, (pval,closed,'a) lam) sum ;; - -let rec rule : type a b. - (pval, closed, (a,b) tarr) lam -> (pval, closed, a) lam -> b rlam = - fun v1 v2 -> - match v1, v2 with - | Lam(x,body), v -> - begin - match subst body (Bind (x, v, Id)) with Ex term -> - match mode term with - | Pexp -> Inl term - | Pval -> Inr term - end - | Const (IntTo b, f), Const (IntR, x) -> - Inr (Const (b, f x)) -;; -let rec onestep : type m t. (m,closed,t) lam -> t rlam = function - | Lam (v, body) -> Inr (Lam (v, body)) - | Const (r, v) -> Inr (Const (r, v)) - | App (e1, e2) -> - match mode e1, mode e2 with - | Pexp, _-> - begin match onestep e1 with - | Inl e -> Inl(App(e,e2)) - | Inr v -> Inl(App(v,e2)) - end - | Pval, Pexp -> - begin match onestep e2 with - | Inl e -> Inl(App(e1,e)) - | Inr v -> Inl(App(e1,v)) - end - | Pval, Pval -> rule e1 e2 -;; -type ('env, 'a) var = - | Zero : ('a * 'env, 'a) var - | Succ : ('env, 'a) var -> ('b * 'env, 'a) var -;; -type ('env, 'a) typ = - | Tint : ('env, int) typ - | Tbool : ('env, bool) typ - | Tvar : ('env, 'a) var -> ('env, 'a) typ -;; -let f : type env a. (env, a) typ -> (env, a) typ -> int = fun ta tb -> - match ta, tb with - | Tint, Tint -> 0 - | Tbool, Tbool -> 1 - | Tvar var, tb -> 2 - | _ -> . (* error *) -;; -(* let x = f Tint (Tvar Zero) ;; *) -type inkind = [ `Link | `Nonlink ] - -type _ inline_t = - | Text: string -> [< inkind > `Nonlink ] inline_t - | Bold: 'a inline_t list -> 'a inline_t - | Link: string -> [< inkind > `Link ] inline_t - | Mref: string * [ `Nonlink ] inline_t list -> [< inkind > `Link ] inline_t -;; - -let uppercase seq = - let rec process: type a. a inline_t -> a inline_t = function - | Text txt -> Text (String.uppercase_ascii txt) - | Bold xs -> Bold (List.map process xs) - | Link lnk -> Link lnk - | Mref (lnk, xs) -> Mref (lnk, List.map process xs) - in List.map process seq -;; - -type ast_t = - | Ast_Text of string - | Ast_Bold of ast_t list - | Ast_Link of string - | Ast_Mref of string * ast_t list -;; - -let inlineseq_from_astseq seq = - let rec process_nonlink = function - | Ast_Text txt -> Text txt - | Ast_Bold xs -> Bold (List.map process_nonlink xs) - | _ -> assert false in - let rec process_any = function - | Ast_Text txt -> Text txt - | Ast_Bold xs -> Bold (List.map process_any xs) - | Ast_Link lnk -> Link lnk - | Ast_Mref (lnk, xs) -> Mref (lnk, List.map process_nonlink xs) - in List.map process_any seq -;; - -(* OK *) -type _ linkp = - | Nonlink : [ `Nonlink ] linkp - | Maylink : inkind linkp -;; -let inlineseq_from_astseq seq = - let rec process : type a. a linkp -> ast_t -> a inline_t = - fun allow_link ast -> - match (allow_link, ast) with - | (Maylink, Ast_Text txt) -> Text txt - | (Nonlink, Ast_Text txt) -> Text txt - | (x, Ast_Bold xs) -> Bold (List.map (process x) xs) - | (Maylink, Ast_Link lnk) -> Link lnk - | (Nonlink, Ast_Link _) -> assert false - | (Maylink, Ast_Mref (lnk, xs)) -> - Mref (lnk, List.map (process Nonlink) xs) - | (Nonlink, Ast_Mref _) -> assert false - in List.map (process Maylink) seq -;; - -(* Bad *) -type _ linkp2 = Kind : 'a linkp -> ([< inkind ] as 'a) linkp2 -;; -let inlineseq_from_astseq seq = -let rec process : type a. a linkp2 -> ast_t -> a inline_t = - fun allow_link ast -> - match (allow_link, ast) with - | (Kind _, Ast_Text txt) -> Text txt - | (x, Ast_Bold xs) -> Bold (List.map (process x) xs) - | (Kind Maylink, Ast_Link lnk) -> Link lnk - | (Kind Nonlink, Ast_Link _) -> assert false - | (Kind Maylink, Ast_Mref (lnk, xs)) -> - Mref (lnk, List.map (process (Kind Nonlink)) xs) - | (Kind Nonlink, Ast_Mref _) -> assert false - in List.map (process (Kind Maylink)) seq -;; -module Add (T : sig type two end) = -struct - type _ t = - | One : [`One] t - | Two : T.two t - - let add (type a) : a t * a t -> string = function - | One, One -> "two" - | Two, Two -> "four" -end;; -module B : sig - type (_, _) t = Eq: ('a, 'a) t - val f: 'a -> 'b -> ('a, 'b) t -end -= -struct - type (_, _) t = Eq: ('a, 'a) t - let f t1 t2 = Obj.magic Eq -end;; - -let of_type: type a. a -> a = fun x -> - match B.f x 4 with - | Eq -> 5 -;; -type _ constant = - | Int: int -> int constant - | Bool: bool -> bool constant - -type (_, _, _) binop = - | Eq: ('a, 'a, bool) binop - | Leq: ('a, 'a, bool) binop - | Add: (int, int, int) binop - -let eval (type a) (type b) (type c) (bop:(a,b,c) binop) (x:a constant) - (y:b constant) : c constant = - match bop, x, y with - | Eq, Bool x, Bool y -> Bool (if x then y else not y) - | Leq, Int x, Int y -> Bool (x <= y) - | Leq, Bool x, Bool y -> Bool (x <= y) - | Add, Int x, Int y -> Int (x + y) - -let _ = eval Eq (Int 2) (Int 3) -type tag = [`TagA | `TagB | `TagC];; - -type 'a poly = - AandBTags : [< `TagA of int | `TagB ] poly - | ATag : [< `TagA of int] poly -(* constraint 'a = [< `TagA of int | `TagB] *) -;; - -let intA = function `TagA i -> i -let intB = function `TagB -> 4 -;; - -let intAorB = function - `TagA i -> i - | `TagB -> 4 -;; - -type _ wrapPoly = - WrapPoly : 'a poly -> ([< `TagA of int | `TagB] as 'a) wrapPoly -;; - -let example6 : type a. a wrapPoly -> (a -> int) = - fun w -> - match w with - | WrapPoly ATag -> intA - | WrapPoly _ -> intA (* This should not be allowed *) -;; - -let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *) -;; -module F(S : sig type 'a t end) = struct - type _ ab = - A : int S.t ab - | B : float S.t ab - - let f : int S.t ab -> float S.t ab -> string = - fun (l : int S.t ab) (r : float S.t ab) -> match l, r with - | A, B -> "f A B" -end;; - -module F(S : sig type 'a t end) = struct - type a = int * int - type b = int -> int - - type _ ab = - A : a S.t ab - | B : b S.t ab - - let f : a S.t ab -> b S.t ab -> string = - fun l r -> match l, r with - | A, B -> "f A B" -end;; -type (_, _) t = - Any : ('a, 'b) t - | Eq : ('a, 'a) t -;; - -module M : -sig - type s = private [> `A] - val eq : (s, [`A | `B]) t -end = -struct - type s = [`A | `B] - let eq = Eq -end;; - -let f : (M.s, [`A | `B]) t -> string = function - | Any -> "Any" -;; - -let () = print_endline (f M.eq) ;; - -module N : -sig - type s = private < a : int; .. > - val eq : (s, <a : int; b : bool>) t -end = -struct - type s = <a : int; b : bool> - let eq = Eq -end -;; - -let f : (N.s, <a : int; b : bool>) t -> string = function - | Any -> "Any" -;; -type (_, _) comp = - | Eq : ('a, 'a) comp - | Diff : ('a, 'b) comp -;; - -module U = struct type t = T end;; - -module M : sig - type t = T - val comp : (U.t, t) comp -end = struct - include U - let comp = Eq -end;; - -match M.comp with | Diff -> false;; - -module U = struct type t = {x : int} end;; - -module M : sig - type t = {x : int} - val comp : (U.t, t) comp -end = struct - include U - let comp = Eq -end;; - -match M.comp with | Diff -> false;; -type 'a t = T of 'a -type 'a s = S of 'a - -type (_, _) eq = Refl : ('a, 'a) eq;; - -let f : (int s, int t) eq -> unit = function Refl -> ();; - -module M (S : sig type 'a t = T of 'a type 'a s = T of 'a end) = -struct let f : ('a S.s, 'a S.t) eq -> unit = function Refl -> () end;; -type _ nat = - Zero : [`Zero] nat - | Succ : 'a nat -> [`Succ of 'a] nat;; -type 'a pre_nat = [`Zero | `Succ of 'a];; -type aux = - | Aux : [`Succ of [<[<[<[`Zero] pre_nat] pre_nat] pre_nat]] nat -> aux;; - -let f (Aux x) = - match x with - | Succ Zero -> "1" - | Succ (Succ Zero) -> "2" - | Succ (Succ (Succ Zero)) -> "3" - | Succ (Succ (Succ (Succ Zero))) -> "4" - | _ -> . (* error *) -;; -type _ t = C : ((('a -> 'o) -> 'o) -> ('b -> 'o) -> 'o) t -let f : type a o. ((a -> o) -> o) t -> (a -> o) -> o = - fun C k -> k (fun x -> x);; -type (_, _) t = - A : ('a, 'a) t -| B : string -> ('a, 'b) t -;; - -module M (A : sig module type T end) (B : sig module type T end) = -struct - let f : ((module A.T), (module B.T)) t -> string = function - | B s -> s -end;; - -module A = struct module type T = sig end end;; - -module N = M(A)(A);; - -let x = N.f A;; -type 'a visit_action - -type insert - -type 'a local_visit_action - -type ('a, 'result, 'visit_action) context = - | Local : ('a, ('a * insert) as 'result, 'a local_visit_action) context - | Global : ('a, 'a, 'a visit_action) context -;; - -let vexpr (type visit_action) - : (_, _, visit_action) context -> _ -> visit_action = - function - | Local -> fun _ -> raise Exit - | Global -> fun _ -> raise Exit -;; - -let vexpr (type visit_action) - : ('a, 'result, visit_action) context -> 'a -> visit_action = - function - | Local -> fun _ -> raise Exit - | Global -> fun _ -> raise Exit -;; - -let vexpr (type result) (type visit_action) - : (unit, result, visit_action) context -> unit -> visit_action = - function - | Local -> fun _ -> raise Exit - | Global -> fun _ -> raise Exit -;; -module A = struct - type nil = Cstr - end -open A -;; - -type _ s = - | Nil : nil s - | Cons : 't s -> ('h -> 't) s - -type ('stack, 'typ) var = - | Head : (('typ -> _) s, 'typ) var - | Tail : ('tail s, 'typ) var -> ((_ -> 'tail) s, 'typ) var - -type _ lst = - | CNil : nil lst - | CCons : 'h * ('t lst) -> ('h -> 't) lst -;; - -let rec get_var : type stk ret. (stk s, ret) var -> stk lst -> ret = fun n s -> - match n, s with - | Head, CCons (h, _) -> h - | Tail n', CCons (_, t) -> get_var n' t -;; -type 'a t = [< `Foo | `Bar] as 'a;; -type 'a s = [< `Foo | `Bar | `Baz > `Bar] as 'a;; - -type 'a first = First : 'a second -> ('b t as 'a) first -and 'a second = Second : ('b s as 'a) second;; - -type aux = Aux : 'a t second * ('a -> int) -> aux;; - -let it : 'a. [< `Bar | `Foo > `Bar ] as 'a = `Bar;; - -let g (Aux(Second, f)) = f it;; -type (_, _) eqp = Y : ('a, 'a) eqp | N : string -> ('a, 'b) eqp -let f : ('a list, 'a) eqp -> unit = function N s -> print_string s;; - -module rec A : sig type t = B.t list end = - struct type t = B.t list end -and B : sig type t val eq : (B.t list, t) eqp end = - struct - type t = A.t - let eq = Y - end;; - -f B.eq;; -type (_, _) t = - | Nil : ('tl, 'tl) t - | Cons : 'a * ('b, 'tl) t -> ('a * 'b, 'tl) t;; - -let get1 (Cons (x, _) : (_ * 'a, 'a) t) = x ;; (* warn, cf PR#6993 *) - -let get1' = function - | (Cons (x, _) : (_ * 'a, 'a) t) -> x - | Nil -> assert false ;; (* ok *) -type _ t = - Int : int -> int t | String : string -> string t | Same : 'l t -> 'l t;; -let rec f = function Int x -> x | Same s -> f s;; -type 'a tt = 'a t = - Int : int -> int tt | String : string -> string tt | Same : 'l1 t -> 'l2 tt;; -type _ t = I : int t;; - -let f (type a) (x : a t) = - let module M = struct - let (I : a t) = x (* fail because of toplevel let *) - let x = (I : a t) - end in - () ;; - -(* extra example by Stephen Dolan, using recursive modules *) -(* Should not be allowed! *) -type (_,_) eq = Refl : ('a, 'a) eq;; - -let bad (type a) = - let module N = struct - module rec M : sig - val e : (int, a) eq - end = struct - let (Refl : (int, a) eq) = M.e (* must fail for soundness *) - let e : (int, a) eq = Refl - end - end in N.M.e -;; -type +'a n = private int -type nil = private Nil_type -type (_,_) elt = - | Elt_fine: 'nat n -> ('l,'nat * 'l) elt - | Elt: 'nat n -> ('l,'nat -> 'l) elt -type _ t = Nil : nil t | Cons : ('x, 'fx) elt * 'x t -> 'fx t;; - -let undetected: ('a -> 'b -> nil) t -> 'a n -> 'b n -> unit = fun sh i j -> - let Cons(Elt dim, _) = sh in () -;; -type _ t = T : int t;; - -(* Should raise Not_found *) -let _ = match (raise Not_found : float t) with _ -> .;; -type (_, _) eq = Eq : ('a, 'a) eq | Neq : int -> ('a, 'b) eq;; -type 'a t;; -let f (type a) (Neq n : (a, a t) eq) = n;; (* warn! *) - -module F (T : sig type _ t end) = struct - let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *) -end;; -(* First-Order Unification by Structural Recursion *) -(* Conor McBride, JFP 13(6) *) -(* http://strictlypositive.org/publications.html *) - -(* This is a translation of the code part to ocaml *) -(* Of course, we do not prove other properties, not even termination *) - -(* 2.2 Inductive Families *) - -type zero = Zero -type _ succ = Succ -type _ nat = - | NZ : zero nat - | NS : 'a nat -> 'a succ nat - -type _ fin = - | FZ : 'a succ fin - | FS : 'a fin -> 'a succ fin - -(* We cannot define - val empty : zero fin -> 'a - because we cannot write an empty pattern matching. - This might be useful to have *) - -(* In place, prove that the parameter is 'a succ *) -type _ is_succ = IS : 'a succ is_succ - -let fin_succ : type n. n fin -> n is_succ = function - | FZ -> IS - | FS _ -> IS -;; - -(* 3 First-Order Terms, Renaming and Substitution *) - -type 'a term = - | Var of 'a fin - | Leaf - | Fork of 'a term * 'a term - -let var x = Var x - -let lift r : 'm fin -> 'n term = fun x -> Var (r x) - -let rec pre_subst f = function - | Var x -> f x - | Leaf -> Leaf - | Fork (t1, t2) -> Fork (pre_subst f t1, pre_subst f t2) - -let comp_subst f g (x : 'a fin) = pre_subst f (g x) -(* val comp_subst : - ('b fin -> 'c term) -> ('a fin -> 'b term) -> 'a fin -> 'c term *) -;; - -(* 4 The Occur-Check, through thick and thin *) - -let rec thin : type n. n succ fin -> n fin -> n succ fin = - fun x y -> match x, y with - | FZ, y -> FS y - | FS x, FZ -> FZ - | FS x, FS y -> FS (thin x y) - -let bind t f = - match t with - | None -> None - | Some x -> f x -(* val bind : 'a option -> ('a -> 'b option) -> 'b option *) - -let rec thick : type n. n succ fin -> n succ fin -> n fin option = - fun x y -> match x, y with - | FZ, FZ -> None - | FZ, FS y -> Some y - | FS x, FZ -> let IS = fin_succ x in Some FZ - | FS x, FS y -> - let IS = fin_succ x in bind (thick x y) (fun x -> Some (FS x)) - -let rec check : type n. n succ fin -> n succ term -> n term option = - fun x t -> match t with - | Var y -> bind (thick x y) (fun x -> Some (Var x)) - | Leaf -> Some Leaf - | Fork (t1, t2) -> - bind (check x t1) (fun t1 -> - bind (check x t2) (fun t2 -> Some (Fork (t1, t2)))) - -let subst_var x t' y = - match thick x y with - | None -> t' - | Some y' -> Var y' -(* val subst_var : 'a succ fin -> 'a term -> 'a succ fin -> 'a term *) - -let subst x t' = pre_subst (subst_var x t') -(* val subst : 'a succ fin -> 'a term -> 'a succ term -> 'a term *) -;; - -(* 5 A Refinement of Substitution *) - -type (_,_) alist = - | Anil : ('n,'n) alist - | Asnoc : ('m,'n) alist * 'm term * 'm succ fin -> ('m succ, 'n) alist - -let rec sub : type m n. (m,n) alist -> m fin -> n term = function - | Anil -> var - | Asnoc (s, t, x) -> comp_subst (sub s) (subst_var x t) - -let rec append : type m n l. (m,n) alist -> (l,m) alist -> (l,n) alist = - fun r s -> match s with - | Anil -> r - | Asnoc (s, t, x) -> Asnoc (append r s, t, x) - -type _ ealist = EAlist : ('a,'b) alist -> 'a ealist - -let asnoc a t' x = EAlist (Asnoc (a, t', x)) - -(* Extra work: we need sub to work on ealist too, for examples *) -let rec weaken_fin : type n. n fin -> n succ fin = function - | FZ -> FZ - | FS x -> FS (weaken_fin x) - -let weaken_term t = pre_subst (fun x -> Var (weaken_fin x)) t - -let rec weaken_alist : type m n. (m, n) alist -> (m succ, n succ) alist = - function - | Anil -> Anil - | Asnoc (s, t, x) -> Asnoc (weaken_alist s, weaken_term t, weaken_fin x) - -let rec sub' : type m. m ealist -> m fin -> m term = function - | EAlist Anil -> var - | EAlist (Asnoc (s, t, x)) -> - comp_subst (sub' (EAlist (weaken_alist s))) - (fun t' -> weaken_term (subst_var x t t')) - -let subst' d = pre_subst (sub' d) -(* val subst' : 'a ealist -> 'a term -> 'a term *) -;; - -(* 6 First-Order Unification *) - -let flex_flex x y = - match thick x y with - | Some y' -> asnoc Anil (Var y') x - | None -> EAlist Anil -(* val flex_flex : 'a succ fin -> 'a succ fin -> 'a succ ealist *) - -let flex_rigid x t = - bind (check x t) (fun t' -> Some (asnoc Anil t' x)) -(* val flex_rigid : 'a succ fin -> 'a succ term -> 'a succ ealist option *) - -let rec amgu : type m. m term -> m term -> m ealist -> m ealist option = - fun s t acc -> match s, t, acc with - | Leaf, Leaf, _ -> Some acc - | Leaf, Fork _, _ -> None - | Fork _, Leaf, _ -> None - | Fork (s1, s2), Fork (t1, t2), _ -> - bind (amgu s1 t1 acc) (amgu s2 t2) - | Var x, Var y, EAlist Anil -> let IS = fin_succ x in Some (flex_flex x y) - | Var x, t, EAlist Anil -> let IS = fin_succ x in flex_rigid x t - | t, Var x, EAlist Anil -> let IS = fin_succ x in flex_rigid x t - | s, t, EAlist(Asnoc(d,r,z)) -> - bind (amgu (subst z r s) (subst z r t) (EAlist d)) - (fun (EAlist d) -> Some (asnoc d r z)) - -let mgu s t = amgu s t (EAlist Anil) -(* val mgu : 'a term -> 'a term -> 'a ealist option *) -;; - -let s = Fork (Var FZ, Fork (Var (FS (FS FZ)), Leaf)) -let t = Fork (Var (FS FZ), Var (FS FZ)) -let d = match mgu s t with Some x -> x | None -> failwith "mgu" -let s' = subst' d s -let t' = subst' d t -;; -(* Injectivity *) - -type (_, _) eq = Refl : ('a, 'a) eq - -let magic : 'a 'b. 'a -> 'b = - fun (type a b) (x : a) -> - let module M = - (functor (T : sig type 'a t end) -> - struct - let f (Refl : (a T.t, b T.t) eq) = (x :> b) - end) - (struct type 'a t = unit end) - in M.f Refl -;; - -(* Variance and subtyping *) - -type (_, +_) eq = Refl : ('a, 'a) eq - -let magic : 'a 'b. 'a -> 'b = - fun (type a) (type b) (x : a) -> - let bad_proof (type a) = - (Refl : (< m : a>, <m : a>) eq :> (<m : a>, < >) eq) in - let downcast : type a. (a, < >) eq -> < > -> a = - fun (type a) (Refl : (a, < >) eq) (s : < >) -> (s :> a) in - (downcast bad_proof ((object method m = x end) :> < >)) # m -;; - -(* Record patterns *) - -type _ t = - | IntLit : int t - | BoolLit : bool t - -let check : type s . s t * s -> bool = function - | BoolLit, false -> false - | IntLit , 6 -> false -;; - -type ('a, 'b) pair = { fst : 'a; snd : 'b } - -let check : type s . (s t, s) pair -> bool = function - | {fst = BoolLit; snd = false} -> false - | {fst = IntLit ; snd = 6} -> false -;; -module type S = sig type t [@@immediate] end;; -module F (M : S) : S = M;; -[%%expect{| -module type S = sig type t [@@immediate] end -module F : functor (M : S) -> S -|}];; - -(* VALID DECLARATIONS *) - -module A = struct - (* Abstract types can be immediate *) - type t [@@immediate] - - (* [@@immediate] tag here is unnecessary but valid since t has it *) - type s = t [@@immediate] - - (* Again, valid alias even without tag *) - type r = s - - (* Mutually recursive declarations work as well *) - type p = q [@@immediate] - and q = int -end;; -[%%expect{| -module A : - sig - type t [@@immediate] - type s = t [@@immediate] - type r = s - type p = q [@@immediate] - and q = int - end -|}];; - -(* Valid using with constraints *) -module type X = sig type t end;; -module Y = struct type t = int end;; -module Z = ((Y : X with type t = int) : sig type t [@@immediate] end);; -[%%expect{| -module type X = sig type t end -module Y : sig type t = int end -module Z : sig type t [@@immediate] end -|}];; - -(* Valid using an explicit signature *) -module M_valid : S = struct type t = int end;; -module FM_valid = F (struct type t = int end);; -[%%expect{| -module M_valid : S -module FM_valid : S -|}];; - -(* Practical usage over modules *) -module Foo : sig type t val x : t ref end = struct - type t = int - let x = ref 0 -end;; -[%%expect{| -module Foo : sig type t val x : t ref end -|}];; - -module Bar : sig type t [@@immediate] val x : t ref end = struct - type t = int - let x = ref 0 -end;; -[%%expect{| -module Bar : sig type t [@@immediate] val x : t ref end -|}];; - -let test f = - let start = Sys.time() in f (); - (Sys.time() -. start);; -[%%expect{| -val test : (unit -> 'a) -> float = <fun> -|}];; - -let test_foo () = - for i = 0 to 100_000_000 do - Foo.x := !Foo.x - done;; -[%%expect{| -val test_foo : unit -> unit = <fun> -|}];; - -let test_bar () = - for i = 0 to 100_000_000 do - Bar.x := !Bar.x - done;; -[%%expect{| -val test_bar : unit -> unit = <fun> -|}];; - -(* Uncomment these to test. Should see substantial speedup! -let () = Printf.printf "No @@immediate: %fs\n" (test test_foo) -let () = Printf.printf "With @@immediate: %fs\n" (test test_bar) *) - - -(* INVALID DECLARATIONS *) - -(* Cannot directly declare a non-immediate type as immediate *) -module B = struct - type t = string [@@immediate] -end;; -[%%expect{| -Line _, characters 2-31: -Error: Types marked with the immediate attribute must be - non-pointer types like int or bool -|}];; - -(* Not guaranteed that t is immediate, so this is an invalid declaration *) -module C = struct - type t - type s = t [@@immediate] -end;; -[%%expect{| -Line _, characters 2-26: -Error: Types marked with the immediate attribute must be - non-pointer types like int or bool -|}];; - -(* Can't ascribe to an immediate type signature with a non-immediate type *) -module D : sig type t [@@immediate] end = struct - type t = string -end;; -[%%expect{| -Line _, characters 42-70: -Error: Signature mismatch: - Modules do not match: - sig type t = string end - is not included in - sig type t [@@immediate] end - Type declarations do not match: - type t = string - is not included in - type t [@@immediate] - the first is not an immediate type. -|}];; - -(* Same as above but with explicit signature *) -module M_invalid : S = struct type t = string end;; -module FM_invalid = F (struct type t = string end);; -[%%expect{| -Line _, characters 23-49: -Error: Signature mismatch: - Modules do not match: sig type t = string end is not included in S - Type declarations do not match: - type t = string - is not included in - type t [@@immediate] - the first is not an immediate type. -|}];; - -(* Can't use a non-immediate type even if mutually recursive *) -module E = struct - type t = s [@@immediate] - and s = string -end;; -[%%expect{| -Line _, characters 2-26: -Error: Types marked with the immediate attribute must be - non-pointer types like int or bool -|}];; -(* - Implicit unpack allows to omit the signature in (val ...) expressions. - - It also adds (module M : S) and (module M) patterns, relying on - implicit (val ...) for the implementation. Such patterns can only - be used in function definition, match clauses, and let ... in. - - New: implicit pack is also supported, and you only need to be able - to infer the the module type path from the context. - *) -(* ocaml -principal *) - -(* Use a module pattern *) -let sort (type s) (module Set : Set.S with type elt = s) l = - Set.elements (List.fold_right Set.add l Set.empty) - -(* No real improvement here? *) -let make_set (type s) cmp : (module Set.S with type elt = s) = - (module Set.Make (struct type t = s let compare = cmp end)) - -(* No type annotation here *) -let sort_cmp (type s) cmp = - sort (module Set.Make (struct type t = s let compare = cmp end)) - -module type S = sig type t val x : t end;; -let f (module M : S with type t = int) = M.x;; -let f (module M : S with type t = 'a) = M.x;; (* Error *) -let f (type a) (module M : S with type t = a) = M.x;; -f (module struct type t = int let x = 1 end);; - -type 'a s = {s: (module S with type t = 'a)};; -{s=(module struct type t = int let x = 1 end)};; -let f {s=(module M)} = M.x;; (* Error *) -let f (type a) ({s=(module M)} : a s) = M.x;; - -type s = {s: (module S with type t = int)};; -let f {s=(module M)} = M.x;; -let f {s=(module M)} {s=(module N)} = M.x + N.x;; - -module type S = sig val x : int end;; -let f (module M : S) y (module N : S) = M.x + y + N.x;; -let m = (module struct let x = 3 end);; (* Error *) -let m = (module struct let x = 3 end : S);; -f m 1 m;; -f m 1 (module struct let x = 2 end);; - -let (module M) = m in M.x;; -let (module M) = m;; (* Error: only allowed in [let .. in] *) -class c = let (module M) = m in object end;; (* Error again *) -module M = (val m);; - -module type S' = sig val f : int -> int end;; -(* Even works with recursion, but must be fully explicit *) -let rec (module M : S') = - (module struct let f n = if n <= 0 then 1 else n * M.f (n-1) end : S') -in M.f 3;; - -(* Subtyping *) - -module type S = sig type t type u val x : t * u end -let f (l : (module S with type t = int and type u = bool) list) = - (l :> (module S with type u = bool) list) - -(* GADTs from the manual *) -(* the only modification is in to_string *) - -module TypEq : sig - type ('a, 'b) t - val apply: ('a, 'b) t -> 'a -> 'b - val refl: ('a, 'a) t - val sym: ('a, 'b) t -> ('b, 'a) t -end = struct - type ('a, 'b) t = ('a -> 'b) * ('b -> 'a) - let refl = (fun x -> x), (fun x -> x) - let apply (f, _) x = f x - let sym (f, g) = (g, f) -end - -module rec Typ : sig - module type PAIR = sig - type t and t1 and t2 - val eq: (t, t1 * t2) TypEq.t - val t1: t1 Typ.typ - val t2: t2 Typ.typ - end - - type 'a typ = - | Int of ('a, int) TypEq.t - | String of ('a, string) TypEq.t - | Pair of (module PAIR with type t = 'a) -end = Typ - -let int = Typ.Int TypEq.refl - -let str = Typ.String TypEq.refl - -let pair (type s1) (type s2) t1 t2 = - let module P = struct - type t = s1 * s2 - type t1 = s1 - type t2 = s2 - let eq = TypEq.refl - let t1 = t1 - let t2 = t2 - end in - Typ.Pair (module P) - -open Typ -let rec to_string: 'a. 'a Typ.typ -> 'a -> string = - fun (type s) t x -> - match (t : s typ) with - | Int eq -> string_of_int (TypEq.apply eq x) - | String eq -> Printf.sprintf "%S" (TypEq.apply eq x) - | Pair (module P) -> - let (x1, x2) = TypEq.apply P.eq x in - Printf.sprintf "(%s,%s)" (to_string P.t1 x1) (to_string P.t2 x2) - -(* Wrapping maps *) -module type MapT = sig - include Map.S - type data - type map - val of_t : data t -> map - val to_t : map -> data t -end - -type ('k,'d,'m) map = - (module MapT with type key = 'k and type data = 'd and type map = 'm) - -let add (type k) (type d) (type m) (m:(k,d,m) map) x y s = - let module M = - (val m:MapT with type key = k and type data = d and type map = m) in - M.of_t (M.add x y (M.to_t s)) - -module SSMap = struct - include Map.Make(String) - type data = string - type map = data t - let of_t x = x - let to_t x = x -end - -let ssmap = - (module SSMap: - MapT with type key = string and type data = string and type map = SSMap.map) -;; - -let ssmap = - (module struct include SSMap end : - MapT with type key = string and type data = string and type map = SSMap.map) -;; - -let ssmap = - (let module S = struct include SSMap end in (module S) : - (module - MapT with type key = string and type data = string and type map = SSMap.map)) -;; - -let ssmap = - (module SSMap: MapT with type key = _ and type data = _ and type map = _) -;; - -let ssmap : (_,_,_) map = (module SSMap);; - -add ssmap;; -open StdLabels -open MoreLabels - -(* Use maps for substitutions and sets for free variables *) - -module Subst = Map.Make(struct type t = string let compare = compare end) -module Names = Set.Make(struct type t = string let compare = compare end) - - -(* Variables are common to lambda and expr *) - -type var = [`Var of string] - -let subst_var ~subst : var -> _ = - function `Var s as x -> - try Subst.find s subst - with Not_found -> x - -let free_var : var -> _ = function `Var s -> Names.singleton s - - -(* The lambda language: free variables, substitutions, and evaluation *) - -type 'a lambda = [`Var of string | `Abs of string * 'a | `App of 'a * 'a] - -let free_lambda ~free_rec : _ lambda -> _ = function - #var as x -> free_var x - | `Abs (s, t) -> Names.remove s (free_rec t) - | `App (t1, t2) -> Names.union (free_rec t1) (free_rec t2) - -let map_lambda ~map_rec : _ lambda -> _ = function - #var as x -> x - | `Abs (s, t) as l -> - let t' = map_rec t in - if t == t' then l else `Abs(s, t') - | `App (t1, t2) as l -> - let t'1 = map_rec t1 and t'2 = map_rec t2 in - if t'1 == t1 && t'2 == t2 then l else `App (t'1, t'2) - -let next_id = - let current = ref 3 in - fun () -> incr current; !current - -let subst_lambda ~subst_rec ~free ~subst : _ lambda -> _ = function - #var as x -> subst_var ~subst x - | `Abs(s, t) as l -> - let used = free t in - let used_expr = - Subst.fold subst ~init:[] - ~f:(fun ~key ~data acc -> - if Names.mem s used then data::acc else acc) in - if List.exists used_expr ~f:(fun t -> Names.mem s (free t)) then - let name = s ^ string_of_int (next_id ()) in - `Abs(name, - subst_rec ~subst:(Subst.add ~key:s ~data:(`Var name) subst) t) - else - map_lambda ~map_rec:(subst_rec ~subst:(Subst.remove s subst)) l - | `App _ as l -> - map_lambda ~map_rec:(subst_rec ~subst) l - -let eval_lambda ~eval_rec ~subst l = - match map_lambda ~map_rec:eval_rec l with - `App(`Abs(s,t1), t2) -> - eval_rec (subst ~subst:(Subst.add ~key:s ~data:t2 Subst.empty) t1) - | t -> t - -(* Specialized versions to use on lambda *) - -let rec free1 x = free_lambda ~free_rec:free1 x -let rec subst1 ~subst = subst_lambda ~subst_rec:subst1 ~free:free1 ~subst -let rec eval1 x = eval_lambda ~eval_rec:eval1 ~subst:subst1 x - - -(* The expr language of arithmetic expressions *) - -type 'a expr = - [`Var of string | `Num of int | `Add of 'a * 'a - | `Neg of 'a | `Mult of 'a * 'a] - -let free_expr ~free_rec : _ expr -> _ = function - #var as x -> free_var x - | `Num _ -> Names.empty - | `Add(x, y) -> Names.union (free_rec x) (free_rec y) - | `Neg x -> free_rec x - | `Mult(x, y) -> Names.union (free_rec x) (free_rec y) - -(* Here map_expr helps a lot *) -let map_expr ~map_rec : _ expr -> _ = function - #var as x -> x - | `Num _ as x -> x - | `Add(x, y) as e -> - let x' = map_rec x and y' = map_rec y in - if x == x' && y == y' then e - else `Add(x', y') - | `Neg x as e -> - let x' = map_rec x in - if x == x' then e else `Neg x' - | `Mult(x, y) as e -> - let x' = map_rec x and y' = map_rec y in - if x == x' && y == y' then e - else `Mult(x', y') - -let subst_expr ~subst_rec ~subst : _ expr -> _ = function - #var as x -> subst_var ~subst x - | #expr as e -> map_expr ~map_rec:(subst_rec ~subst) e - -let eval_expr ~eval_rec e = - match map_expr ~map_rec:eval_rec e with - `Add(`Num m, `Num n) -> `Num (m+n) - | `Neg(`Num n) -> `Num (-n) - | `Mult(`Num m, `Num n) -> `Num (m*n) - | #expr as e -> e - -(* Specialized versions *) - -let rec free2 x = free_expr ~free_rec:free2 x -let rec subst2 ~subst = subst_expr ~subst_rec:subst2 ~subst -let rec eval2 x = eval_expr ~eval_rec:eval2 x - - -(* The lexpr language, reunion of lambda and expr *) - -type lexpr = - [ `Var of string | `Abs of string * lexpr | `App of lexpr * lexpr - | `Num of int | `Add of lexpr * lexpr | `Neg of lexpr - | `Mult of lexpr * lexpr ] - -let rec free : lexpr -> _ = function - #lambda as x -> free_lambda ~free_rec:free x - | #expr as x -> free_expr ~free_rec:free x - -let rec subst ~subst:s : lexpr -> _ = function - #lambda as x -> subst_lambda ~subst_rec:subst ~subst:s ~free x - | #expr as x -> subst_expr ~subst_rec:subst ~subst:s x - -let rec eval : lexpr -> _ = function - #lambda as x -> eval_lambda ~eval_rec:eval ~subst x - | #expr as x -> eval_expr ~eval_rec:eval x - -let rec print = function - | `Var id -> print_string id - | `Abs (id, l) -> print_string ("\ " ^ id ^ " . "); print l - | `App (l1, l2) -> print l1; print_string " "; print l2 - | `Num x -> print_int x - | `Add (e1, e2) -> print e1; print_string " + "; print e2 - | `Neg e -> print_string "-"; print e - | `Mult (e1, e2) -> print e1; print_string " * "; print e2 - -let () = - let e1 = eval1 (`App(`Abs("x",`Var"x"), `Var"y")) in - let e2 = eval2 (`Add(`Mult(`Num 3,`Neg(`Num 2)), `Var"x")) in - let e3 = eval (`Add(`App(`Abs("x",`Mult(`Var"x",`Var"x")),`Num 2), `Num 5)) in - print e1; print_newline (); - print e2; print_newline (); - print e3; print_newline () -(* Full fledge version, using objects to structure code *) - -open StdLabels -open MoreLabels - -(* Use maps for substitutions and sets for free variables *) - -module Subst = Map.Make(struct type t = string let compare = compare end) -module Names = Set.Make(struct type t = string let compare = compare end) - -(* To build recursive objects *) - -let lazy_fix make = - let rec obj () = make (lazy (obj ()) : _ Lazy.t) in - obj () - -let (!!) = Lazy.force - -(* The basic operations *) - -class type ['a, 'b] ops = - object - method free : x:'b -> ?y:'c -> Names.t - method subst : sub:'a Subst.t -> 'b -> 'a - method eval : 'b -> 'a - end - -(* Variables are common to lambda and expr *) - -type var = [`Var of string] - -class ['a] var_ops = object (self : ('a, var) #ops) - constraint 'a = [> var] - method subst ~sub (`Var s as x) = - try Subst.find s sub with Not_found -> x - method free (`Var s) = - Names.singleton s - method eval (#var as v) = v -end - -(* The lambda language: free variables, substitutions, and evaluation *) - -type 'a lambda = [`Var of string | `Abs of string * 'a | `App of 'a * 'a] - -let next_id = - let current = ref 3 in - fun () -> incr current; !current - -class ['a] lambda_ops (ops : ('a,'a) #ops Lazy.t) = - let var : 'a var_ops = new var_ops - and free = lazy !!ops#free - and subst = lazy !!ops#subst - and eval = lazy !!ops#eval in - object (self : ('a, 'a lambda) #ops) - constraint 'a = [> 'a lambda] - method free = function - #var as x -> var#free x - | `Abs (s, t) -> Names.remove s (!!free t) - | `App (t1, t2) -> Names.union (!!free t1) (!!free t2) - - method map ~f = function - #var as x -> x - | `Abs (s, t) as l -> - let t' = f t in - if t == t' then l else `Abs(s, t') - | `App (t1, t2) as l -> - let t'1 = f t1 and t'2 = f t2 in - if t'1 == t1 && t'2 == t2 then l else `App (t'1, t'2) - - method subst ~sub = function - #var as x -> var#subst ~sub x - | `Abs(s, t) as l -> - let used = !!free t in - let used_expr = - Subst.fold sub ~init:[] - ~f:(fun ~key ~data acc -> - if Names.mem s used then data::acc else acc) in - if List.exists used_expr ~f:(fun t -> Names.mem s (!!free t)) then - let name = s ^ string_of_int (next_id ()) in - `Abs(name, - !!subst ~sub:(Subst.add ~key:s ~data:(`Var name) sub) t) - else - self#map ~f:(!!subst ~sub:(Subst.remove s sub)) l - | `App _ as l -> - self#map ~f:(!!subst ~sub) l - - method eval l = - match self#map ~f:!!eval l with - `App(`Abs(s,t1), t2) -> - !!eval (!!subst ~sub:(Subst.add ~key:s ~data:t2 Subst.empty) t1) - | t -> t -end - -(* Operations specialized to lambda *) - -let lambda = lazy_fix (new lambda_ops) - -(* The expr language of arithmetic expressions *) - -type 'a expr = - [ `Var of string | `Num of int | `Add of 'a * 'a - | `Neg of 'a | `Mult of 'a * 'a] - -class ['a] expr_ops (ops : ('a,'a) #ops Lazy.t) = - let var : 'a var_ops = new var_ops - and free = lazy !!ops#free - and subst = lazy !!ops#subst - and eval = lazy !!ops#eval in - object (self : ('a, 'a expr) #ops) - constraint 'a = [> 'a expr] - method free = function - #var as x -> var#free x - | `Num _ -> Names.empty - | `Add(x, y) -> Names.union (!!free x) (!!free y) - | `Neg x -> !!free x - | `Mult(x, y) -> Names.union (!!free x) (!!free y) - - method map ~f = function - #var as x -> x - | `Num _ as x -> x - | `Add(x, y) as e -> - let x' = f x and y' = f y in - if x == x' && y == y' then e - else `Add(x', y') - | `Neg x as e -> - let x' = f x in - if x == x' then e else `Neg x' - | `Mult(x, y) as e -> - let x' = f x and y' = f y in - if x == x' && y == y' then e - else `Mult(x', y') - - method subst ~sub = function - #var as x -> var#subst ~sub x - | #expr as e -> self#map ~f:(!!subst ~sub) e - - method eval (#expr as e) = - match self#map ~f:!!eval e with - `Add(`Num m, `Num n) -> `Num (m+n) - | `Neg(`Num n) -> `Num (-n) - | `Mult(`Num m, `Num n) -> `Num (m*n) - | e -> e - end - -(* Specialized versions *) - -let expr = lazy_fix (new expr_ops) - -(* The lexpr language, reunion of lambda and expr *) - -type 'a lexpr = [ 'a lambda | 'a expr ] - -class ['a] lexpr_ops (ops : ('a,'a) #ops Lazy.t) = - let lambda = new lambda_ops ops in - let expr = new expr_ops ops in - object (self : ('a, 'a lexpr) #ops) - constraint 'a = [> 'a lexpr] - method free = function - #lambda as x -> lambda#free x - | #expr as x -> expr#free x - - method subst ~sub = function - #lambda as x -> lambda#subst ~sub x - | #expr as x -> expr#subst ~sub x - - method eval = function - #lambda as x -> lambda#eval x - | #expr as x -> expr#eval x -end - -let lexpr = lazy_fix (new lexpr_ops) - -let rec print = function - | `Var id -> print_string id - | `Abs (id, l) -> print_string ("\ " ^ id ^ " . "); print l - | `App (l1, l2) -> print l1; print_string " "; print l2 - | `Num x -> print_int x - | `Add (e1, e2) -> print e1; print_string " + "; print e2 - | `Neg e -> print_string "-"; print e - | `Mult (e1, e2) -> print e1; print_string " * "; print e2 - -let () = - let e1 = lambda#eval (`App(`Abs("x",`Var"x"), `Var"y")) in - let e2 = expr#eval (`Add(`Mult(`Num 3,`Neg(`Num 2)), `Var"x")) in - let e3 = - lexpr#eval (`Add(`App(`Abs("x",`Mult(`Var"x",`Var"x")),`Num 2), `Num 5)) - in - print e1; print_newline (); - print e2; print_newline (); - print e3; print_newline () -(* Full fledge version, using objects to structure code *) - -open StdLabels -open MoreLabels - -(* Use maps for substitutions and sets for free variables *) - -module Subst = Map.Make(struct type t = string let compare = compare end) -module Names = Set.Make(struct type t = string let compare = compare end) - -(* To build recursive objects *) - -let lazy_fix make = - let rec obj () = make (lazy (obj ()) : _ Lazy.t) in - obj () - -let (!!) = Lazy.force - -(* The basic operations *) - -class type ['a, 'b] ops = - object - method free : 'b -> Names.t - method subst : sub:'a Subst.t -> 'b -> 'a - method eval : 'b -> 'a - end - -(* Variables are common to lambda and expr *) - -type var = [`Var of string] - -let var = object (self : ([>var], var) #ops) - method subst ~sub (`Var s as x) = - try Subst.find s sub with Not_found -> x - method free (`Var s) = - Names.singleton s - method eval (#var as v) = v -end - -(* The lambda language: free variables, substitutions, and evaluation *) - -type 'a lambda = [`Var of string | `Abs of string * 'a | `App of 'a * 'a] - -let next_id = - let current = ref 3 in - fun () -> incr current; !current - -let lambda_ops (ops : ('a,'a) #ops Lazy.t) = - let free = lazy !!ops#free - and subst = lazy !!ops#subst - and eval = lazy !!ops#eval in - object (self : ([> 'a lambda], 'a lambda) #ops) - method free = function - #var as x -> var#free x - | `Abs (s, t) -> Names.remove s (!!free t) - | `App (t1, t2) -> Names.union (!!free t1) (!!free t2) - - method private map ~f = function - #var as x -> x - | `Abs (s, t) as l -> - let t' = f t in - if t == t' then l else `Abs(s, t') - | `App (t1, t2) as l -> - let t'1 = f t1 and t'2 = f t2 in - if t'1 == t1 && t'2 == t2 then l else `App (t'1, t'2) - - method subst ~sub = function - #var as x -> var#subst ~sub x - | `Abs(s, t) as l -> - let used = !!free t in - let used_expr = - Subst.fold sub ~init:[] - ~f:(fun ~key ~data acc -> - if Names.mem s used then data::acc else acc) in - if List.exists used_expr ~f:(fun t -> Names.mem s (!!free t)) then - let name = s ^ string_of_int (next_id ()) in - `Abs(name, - !!subst ~sub:(Subst.add ~key:s ~data:(`Var name) sub) t) - else - self#map ~f:(!!subst ~sub:(Subst.remove s sub)) l - | `App _ as l -> - self#map ~f:(!!subst ~sub) l - - method eval l = - match self#map ~f:!!eval l with - `App(`Abs(s,t1), t2) -> - !!eval (!!subst ~sub:(Subst.add ~key:s ~data:t2 Subst.empty) t1) - | t -> t -end - -(* Operations specialized to lambda *) - -let lambda = lazy_fix lambda_ops - -(* The expr language of arithmetic expressions *) - -type 'a expr = - [ `Var of string | `Num of int | `Add of 'a * 'a - | `Neg of 'a | `Mult of 'a * 'a] - -let expr_ops (ops : ('a,'a) #ops Lazy.t) = - let free = lazy !!ops#free - and subst = lazy !!ops#subst - and eval = lazy !!ops#eval in - object (self : ([> 'a expr], 'a expr) #ops) - method free = function - #var as x -> var#free x - | `Num _ -> Names.empty - | `Add(x, y) -> Names.union (!!free x) (!!free y) - | `Neg x -> !!free x - | `Mult(x, y) -> Names.union (!!free x) (!!free y) - - method private map ~f = function - #var as x -> x - | `Num _ as x -> x - | `Add(x, y) as e -> - let x' = f x and y' = f y in - if x == x' && y == y' then e - else `Add(x', y') - | `Neg x as e -> - let x' = f x in - if x == x' then e else `Neg x' - | `Mult(x, y) as e -> - let x' = f x and y' = f y in - if x == x' && y == y' then e - else `Mult(x', y') - - method subst ~sub = function - #var as x -> var#subst ~sub x - | #expr as e -> self#map ~f:(!!subst ~sub) e - - method eval (#expr as e) = - match self#map ~f:!!eval e with - `Add(`Num m, `Num n) -> `Num (m+n) - | `Neg(`Num n) -> `Num (-n) - | `Mult(`Num m, `Num n) -> `Num (m*n) - | e -> e - end - -(* Specialized versions *) - -let expr = lazy_fix expr_ops - -(* The lexpr language, reunion of lambda and expr *) - -type 'a lexpr = [ 'a lambda | 'a expr ] - -let lexpr_ops (ops : ('a,'a) #ops Lazy.t) = - let lambda = lambda_ops ops in - let expr = expr_ops ops in - object (self : ([> 'a lexpr], 'a lexpr) #ops) - method free = function - #lambda as x -> lambda#free x - | #expr as x -> expr#free x - - method subst ~sub = function - #lambda as x -> lambda#subst ~sub x - | #expr as x -> expr#subst ~sub x - - method eval = function - #lambda as x -> lambda#eval x - | #expr as x -> expr#eval x -end - -let lexpr = lazy_fix lexpr_ops - -let rec print = function - | `Var id -> print_string id - | `Abs (id, l) -> print_string ("\ " ^ id ^ " . "); print l - | `App (l1, l2) -> print l1; print_string " "; print l2 - | `Num x -> print_int x - | `Add (e1, e2) -> print e1; print_string " + "; print e2 - | `Neg e -> print_string "-"; print e - | `Mult (e1, e2) -> print e1; print_string " * "; print e2 - -let () = - let e1 = lambda#eval (`App(`Abs("x",`Var"x"), `Var"y")) in - let e2 = expr#eval (`Add(`Mult(`Num 3,`Neg(`Num 2)), `Var"x")) in - let e3 = - lexpr#eval (`Add(`App(`Abs("x",`Mult(`Var"x",`Var"x")),`Num 2), `Num 5)) - in - print e1; print_newline (); - print e2; print_newline (); - print e3; print_newline () -type sexp = A of string | L of sexp list -type 'a t = 'a array -let _ = fun (_ : 'a t) -> () - -let array_of_sexp _ _ = [| |] -let sexp_of_array _ _ = A "foo" -let sexp_of_int _ = A "42" -let int_of_sexp _ = 42 - -let t_of_sexp : 'a . (sexp -> 'a) -> sexp -> 'a t= - let _tp_loc = "core_array.ml.t" in - fun _of_a -> fun t -> (array_of_sexp _of_a) t -let _ = t_of_sexp -let sexp_of_t : 'a . ('a -> sexp) -> 'a t -> sexp= - fun _of_a -> fun v -> (sexp_of_array _of_a) v -let _ = sexp_of_t -module T = - struct - module Int = - struct - type t_ = int array - let _ = fun (_ : t_) -> () - - let t__of_sexp: sexp -> t_ = - let _tp_loc = "core_array.ml.T.Int.t_" in - fun t -> (array_of_sexp int_of_sexp) t - let _ = t__of_sexp - let sexp_of_t_: t_ -> sexp = - fun v -> (sexp_of_array sexp_of_int) v - let _ = sexp_of_t_ - end - end -module type Permissioned = - sig - type ('a,-'perms) t - end -module Permissioned : - sig - type ('a,-'perms) t - include - sig - val t_of_sexp : - (sexp -> 'a) -> - (sexp -> 'perms) -> sexp -> ('a,'perms) t - val sexp_of_t : - ('a -> sexp) -> - ('perms -> sexp) -> ('a,'perms) t -> sexp - end - module Int : - sig - type nonrec -'perms t = (int,'perms) t - include - sig - val t_of_sexp : - (sexp -> 'perms) -> sexp -> 'perms t - val sexp_of_t : - ('perms -> sexp) -> 'perms t -> sexp - end - end - end = - struct - type ('a,-'perms) t = 'a array - let _ = fun (_ : ('a,'perms) t) -> () - - let t_of_sexp : - 'a 'perms . - (sexp -> 'a) -> - (sexp -> 'perms) -> sexp -> ('a,'perms) t= - let _tp_loc = "core_array.ml.Permissioned.t" in - fun _of_a -> fun _of_perms -> fun t -> (array_of_sexp _of_a) t - let _ = t_of_sexp - let sexp_of_t : - 'a 'perms . - ('a -> sexp) -> - ('perms -> sexp) -> ('a,'perms) t -> sexp= - fun _of_a -> fun _of_perms -> fun v -> (sexp_of_array _of_a) v - let _ = sexp_of_t - module Int = - struct - include T.Int - type -'perms t = t_ - let _ = fun (_ : 'perms t) -> () - - let t_of_sexp : - 'perms . (sexp -> 'perms) -> sexp -> 'perms t= - let _tp_loc = "core_array.ml.Permissioned.Int.t" in - fun _of_perms -> fun t -> t__of_sexp t - let _ = t_of_sexp - let sexp_of_t : - 'perms . ('perms -> sexp) -> 'perms t -> sexp= - fun _of_perms -> fun v -> sexp_of_t_ v - let _ = sexp_of_t - end - end -type 'a foo = {x: 'a; y: int} -let r = {{x = 0; y = 0} with x = 0} -let r' : string foo = r -external foo : int = "%ignore";; -let _ = foo ();; -type 'a t = [`A of 'a t t] as 'a;; (* fails *) - -type 'a t = [`A of 'a t t];; (* fails *) - -type 'a t = [`A of 'a t t] constraint 'a = 'a t;; - -type 'a t = [`A of 'a t] constraint 'a = 'a t;; - -type 'a t = [`A of 'a] as 'a;; - -type 'a v = [`A of u v] constraint 'a = t and t = u and u = t;; (* fails *) - -type 'a t = 'a;; -let f (x : 'a t as 'a) = ();; (* fails *) - -let f (x : 'a t) (y : 'a) = x = y;; - -(* PR#6505 *) -module type PR6505 = sig - type 'o is_an_object = < .. > as 'o - and 'o abs constraint 'o = 'o is_an_object - val abs : 'o is_an_object -> 'o abs - val unabs : 'o abs -> 'o -end;; (* fails *) -(* PR#5835 *) -let f ~x = x + 1;; -f ?x:0;; - -(* PR#6352 *) -let foo (f : unit -> unit) = ();; -let g ?x () = ();; -foo ((); g);; - -(* PR#5748 *) -foo (fun ?opt () -> ()) ;; (* fails *) -(* PR#5907 *) - -type 'a t = 'a;; -let f (g : 'a list -> 'a t -> 'a) s = g s s;; -let f (g : 'a * 'b -> 'a t -> 'a) s = g s s;; -type ab = [ `A | `B ];; -let f (x : [`A]) = match x with #ab -> 1;; -let f x = ignore (match x with #ab -> 1); ignore (x : [`A]);; -let f x = ignore (match x with `A|`B -> 1); ignore (x : [`A]);; - -let f (x : [< `A | `B]) = match x with `A | `B | `C -> 0;; (* warn *) -let f (x : [`A | `B]) = match x with `A | `B | `C -> 0;; (* fail *) - -(* PR#6787 *) -let revapply x f = f x;; - -let f x (g : [< `Foo]) = - let y = `Bar x, g in - revapply y (fun ((`Bar i), _) -> i);; -(* f : 'a -> [< `Foo ] -> 'a *) - -let rec x = [| x |]; 1.;; - -let rec x = let u = [|y|] in 10. and y = 1.;; -type 'a t -type a - -let f : < .. > t -> unit = fun _ -> ();; - -let g : [< `b] t -> unit = fun _ -> ();; - -let h : [> `b] t -> unit = fun _ -> ();; - -let _ = fun (x : a t) -> f x;; - -let _ = fun (x : a t) -> g x;; - -let _ = fun (x : a t) -> h x;; -(* PR#7012 *) - -type t = [ 'A_name | `Hi ];; - -let f (x:'id_arg) = x;; - -let f (x:'Id_arg) = x;; -(* undefined labels *) -type t = {x:int;y:int};; -{x=3;z=2};; -fun {x=3;z=2} -> ();; - -(* mixed labels *) -{x=3; contents=2};; - -(* private types *) -type u = private {mutable u:int};; -{u=3};; -fun x -> x.u <- 3;; - -(* Punning and abbreviations *) -module M = struct - type t = {x: int; y: int} -end;; - -let f {M.x; y} = x+y;; -let r = {M.x=1; y=2};; -let z = f r;; - -(* messages *) -type foo = { mutable y:int };; -let f (r: int) = r.y <- 3;; - -(* bugs *) -type foo = { y: int; z: int };; -type bar = { x: int };; -let f (r: bar) = ({ r with z = 3 } : foo) - -type foo = { x: int };; -let r : foo = { ZZZ.x = 2 };; - -(ZZZ.X : int option);; - -(* PR#5865 *) -let f (x : Complex.t) = x.Complex.z;; -(* PR#6394 *) - -module rec X : sig - type t = int * bool -end = struct - type t = A | B - let f = function A | B -> 0 -end;; -(* PR#6768 *) - -type _ prod = Prod : ('a * 'y) prod;; - -let f : type t. t prod -> _ = function Prod -> - let module M = - struct - type d = d * d - end - in () -;; -let (a : M.a) = 2 -let (b : M.b) = 2 -let _ = A.a = B.b -module Std = struct module Hash = Hashtbl end;; - -open Std;; -module Hash1 : module type of Hash = Hash;; -module Hash2 : sig include (module type of Hash) end = Hash;; -let f1 (x : (_,_) Hash1.t) = (x : (_,_) Hashtbl.t);; -let f2 (x : (_,_) Hash2.t) = (x : (_,_) Hashtbl.t);; - -(* Another case, not using include *) - -module Std2 = struct module M = struct type t end end;; -module Std' = Std2;; -module M' : module type of Std'.M = Std2.M;; -let f3 (x : M'.t) = (x : Std2.M.t);; - -(* original report required Core_kernel: -module type S = sig -open Core_kernel.Std - -module Hashtbl1 : module type of Hashtbl -module Hashtbl2 : sig - include (module type of Hashtbl) -end - -module Coverage : Core_kernel.Std.Hashable - -type types = unit constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl1.t -type doesnt_type = unit - constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl2.t -end -*) -module type INCLUDING = sig - include module type of List - include module type of ListLabels -end - -module Including_typed: INCLUDING = struct - include List - include ListLabels -end -module X=struct - module type SIG=sig type t=int val x:t end - module F(Y:SIG) : SIG = struct type t=Y.t let x=Y.x end -end;; -module DUMMY=struct type t=int let x=2 end;; -let x = (3 : X.F(DUMMY).t);; - -module X2=struct - module type SIG=sig type t=int val x:t end - module F(Y:SIG)(Z:SIG) = struct - type t=Y.t - let x=Y.x - type t'=Z.t - let x'=Z.x - end -end;; -let x = (3 : X2.F(DUMMY)(DUMMY).t);; -let x = (3 : X2.F(DUMMY)(DUMMY).t');; -module F (M : sig - type 'a t - type 'a u = string - val f : unit -> _ u t - end) = struct - let t = M.f () - end -type 't a = [ `A ] -type 't wrap = 't constraint 't = [> 't wrap a ] -type t = t a wrap - -module T = struct - let foo : 't wrap -> 't wrap -> unit = fun _ _ -> () - let bar : ('a a wrap as 'a) = `A -end - -module Good : sig - val bar: t - val foo: t -> t -> unit -end = T - -module Bad : sig - val foo: t -> t -> unit - val bar: t -end = T -module M : sig - module type T - module F (X : T) : sig end -end = struct - module type T = sig end - module F (X : T) = struct end -end - -module type T = M.T - -module F : functor (X : T) -> sig end = M.F -module type S = sig type t = { a : int; b : int; } end;; -let f (module M : S with type t = int) = { M.a = 0 };; -let flag = ref false -module F(S : sig module type T end) (A : S.T) (B : S.T) = -struct - module X = (val if !flag then (module A) else (module B) : S.T) -end - -(* If the above were accepted, one could break soundness *) -module type S = sig type t val x : t end -module Float = struct type t = float let x = 0.0 end -module Int = struct type t = int let x = 0 end - -module M = F(struct module type T = S end) - -let () = flag := false -module M1 = M(Float)(Int) - -let () = flag := true -module M2 = M(Float)(Int) - -let _ = [| M2.X.x; M1.X.x |] -module type PR6513 = sig -module type S = sig type u end - -module type T = sig - type 'a wrap - type uri -end - -module Make: functor (Html5 : T with type 'a wrap = 'a) -> - S with type u = < foo : Html5.uri > -end - -(* Requires -package tyxml -module type PR6513_orig = sig -module type S = -sig - type t - type u -end - -module Make: functor (Html5: Html5_sigs.T - with type 'a Xml.wrap = 'a and - type 'a wrap = 'a and - type 'a list_wrap = 'a list) - -> S with type t = Html5_types.div Html5.elt and - type u = < foo: Html5.uri > -end -*) -module type S = sig - include Set.S - module E : sig val x : int end -end - -module Make(O : Set.OrderedType) : S with type elt = O.t = - struct - include Set.Make(O) - module E = struct let x = 1 end - end - -module rec A : Set.OrderedType = struct - type t = int - let compare = Pervasives.compare -end -and B : S = struct - module C = Make(A) - include C -end -module type S = sig - module type T - module X : T -end - -module F (X : S) = X.X - -module M = struct - module type T = sig type t end - module X = struct type t = int end -end - -type t = F(M).t -module Common0 = - struct - type msg = Msg - - let handle_msg = ref (function _ -> failwith "Unable to handle message") - let extend_handle f = - let old = !handle_msg in - handle_msg := f old - - let q : _ Queue.t = Queue.create () - let add msg = Queue.add msg q - let handle_queue_messages () = Queue.iter !handle_msg q - end - -let q' : Common0.msg Queue.t = Common0.q - -module Common = - struct - type msg = .. - - let handle_msg = ref (function _ -> failwith "Unable to handle message") - let extend_handle f = - let old = !handle_msg in - handle_msg := f old - - let q : _ Queue.t = Queue.create () - let add msg = Queue.add msg q - let handle_queue_messages () = Queue.iter !handle_msg q - end - -module M1 = - struct - type Common.msg += Reload of string | Alert of string - - let handle fallback = function - Reload s -> print_endline ("Reload "^s) - | Alert s -> print_endline ("Alert "^s) - | x -> fallback x - - let () = Common.extend_handle handle - let () = Common.add (Reload "config.file") - let () = Common.add (Alert "Initialisation done") - end -let should_reject = - let table = Hashtbl.create 1 in - fun x y -> Hashtbl.add table x y -type 'a t = 'a option -let is_some = function - | None -> false - | Some _ -> true - -let should_accept ?x () = is_some x -include struct - let foo `Test = () - let wrap f `Test = f - let bar = wrap () -end -let f () = - let module S = String in - let module N = Map.Make(S) in - N.add "sum" 41 N.empty;; -module X = struct module Y = struct module type S = sig type t end end end - -(* open X (* works! *) *) -module Y = X.Y - -type 'a arg_t = 'at constraint 'a = (module Y.S with type t = 'at) -type t = (module X.Y.S with type t = unit) - -let f (x : t arg_t) = () - -let () = f () -module type S = -sig - type a - type b -end -module Foo - (Bar : S with type a = private [> `A]) - (Baz : S with type b = private < b : Bar.b ; .. >) = -struct -end -module A = struct - module type A_S = sig - end - - type t = (module A_S) -end - -module type S = sig type t end - -let f (type a) (module X : S with type t = a) = () - -let _ = f (module A) (* ok *) - -module A_annotated_alias : S with type t = (module A.A_S) = A - -let _ = f (module A_annotated_alias) (* ok *) -let _ = f (module A_annotated_alias : S with type t = (module A.A_S)) (* ok *) - -module A_alias = A -module A_alias_expanded = struct include A_alias end - -let _ = f (module A_alias_expanded : S with type t = (module A.A_S)) (* ok *) -let _ = f (module A_alias_expanded) (* ok *) - -let _ = f (module A_alias : S with type t = (module A.A_S)) (* doesn't type *) -let _ = f (module A_alias) (* doesn't type either *) -module Foo - (Bar : sig type a = private [> `A ] end) - (Baz : module type of struct include Bar end) = -struct -end -module Bazoinks = struct type a = [ `A ] end -module Bug = Foo(Bazoinks)(Bazoinks) -(* PR#6992, reported by Stephen Dolan *) - -type (_, _) eq = Eq : ('a, 'a) eq -let cast : type a b . (a, b) eq -> a -> b = fun Eq x -> x - -module Fix (F : sig type 'a f end) = struct - type 'a fix = ('a, 'a F.f) eq - let uniq (type a) (type b) (Eq : a fix) (Eq : b fix) : (a, b) eq = Eq -end - -(* This would allow: -module FixId = Fix (struct type 'a f = 'a end) - let bad : (int, string) eq = FixId.uniq Eq Eq - let _ = Printf.printf "Oh dear: %s" (cast bad 42) -*) -module M = struct - module type S = sig type a val v : a end - type 'a s = (module S with type a = 'a) -end - -module B = struct - class type a = object method a : 'a. 'a M.s -> 'a end -end - -module M' = M -module B' = B - -class b : B.a = object - method a : 'a. 'a M.s -> 'a = fun (type a) (module X : M.S with type a = a) -> X.v - method a : 'a. 'a M.s -> 'a = fun (type a) ((module X) : (module M.S with type -a = a)) -> X.v -end - -class b' : B.a = object - method a : 'a. 'a M'.s -> 'a = fun (type a) (module X : M'.S with type a = a) -> X.v - method a : 'a. 'a M'.s -> 'a = fun (type a) ((module X) : (module M'.S with -type a = a)) -> X.v -end -module type FOO = sig type t end -module type BAR = -sig - (* Works: module rec A : (sig include FOO with type t = < b:B.t > end) *) - module rec A : (FOO with type t = < b:B.t >) - and B : FOO -end -module A = struct module type S module S = struct end end -module F (_ : sig end) = struct module type S module S = A.S end -module M = struct end -module N = M -module G (X : F(N).S) : A.S = X -module F (_ : sig end) = struct module type S end -module M = struct end -module N = M -module G (X : F(N).S) : F(M).S = X -module M : sig - type make_dec - val add_dec: make_dec -> unit -end = struct - type u - - module Fast: sig - type 'd t - val create: unit -> 'd t - module type S = sig - module Data: sig type t end - val key: Data.t t - end - module Register (D:S): sig end - val attach: 'd t -> 'd -> unit - end = struct - type 'd t = unit - let create () = () - module type S = sig - module Data: sig type t end - val key: Data.t t - end - module Register (D:S) = struct end - let attach _ _ = () - end - - type make_dec - - module Dem = struct - module Data = struct - type t = make_dec - end - let key = Fast.create () - end - - module EDem = Fast.Register(Dem) - - let add_dec dec = - Fast.attach Dem.key dec -end - -(* simpler version *) - -module Simple = struct - type 'a t - module type S = sig - module Data: sig type t end - val key: Data.t t - end - module Register (D:S) = struct let key = D.key end - module M = struct - module Data = struct type t = int end - let key : _ t = Obj.magic () - end -end;; -module EM = Simple.Register(Simple.M);; -Simple.M.key;; - -module Simple2 = struct - type 'a t - module type S = sig - module Data: sig type t end - val key: Data.t t - end - module M = struct - module Data = struct type t = int end - let key : _ t = Obj.magic () - end - module Register (D:S) = struct let key = D.key end - module EM = Simple.Register(Simple.M) - let k : M.Data.t t = M.key -end;; -module rec M - : sig external f : int -> int = "%identity" end - = struct external f : int -> int = "%identity" end -(* with module *) - -module type S = sig type t and s = t end;; -module type S' = S with type t := int;; - -module type S = sig module rec M : sig end and N : sig end end;; -module type S' = S with module M := String;; - -(* with module type *) -(* -module type S = sig module type T module F(X:T) : T end;; -module type T0 = sig type t end;; -module type S1 = S with module type T = T0;; -module type S2 = S with module type T := T0;; -module type S3 = S with module type T := sig type t = int end;; -module H = struct - include (Hashtbl : module type of Hashtbl with - type statistics := Hashtbl.statistics - and module type S := Hashtbl.S - and module Make := Hashtbl.Make - and module MakeSeeded := Hashtbl.MakeSeeded - and module type SeededS := Hashtbl.SeededS - and module type HashedType := Hashtbl.HashedType - and module type SeededHashedType := Hashtbl.SeededHashedType) -end;; -*) - -(* A subtle problem appearing with -principal *) -type -'a t -class type c = object method m : [ `A ] t end;; -module M : sig val v : (#c as 'a) -> 'a end = - struct let v x = ignore (x :> c); x end;; - -(* PR#4838 *) - -let id = let module M = struct end in fun x -> x;; - -(* PR#4511 *) - -let ko = let module M = struct end in fun _ -> ();; - -(* PR#5993 *) - -module M : sig type -'a t = private int end = - struct type +'a t = private int end -;; - -(* PR#6005 *) - -module type A = sig type t = X of int end;; -type u = X of bool;; -module type B = A with type t = u;; (* fail *) - -(* PR#5815 *) -(* ---> duplicated exception name is now an error *) - -module type S = sig exception Foo of int exception Foo of bool end;; - -(* PR#6410 *) - -module F(X : sig end) = struct let x = 3 end;; -F.x;; (* fail *) -module C = Char;; -C.chr 66;; - -module C' : module type of Char = C;; -C'.chr 66;; - -module C3 = struct include Char end;; -C3.chr 66;; - -let f x = let module M = struct module L = List end in M.L.length x;; -let g x = let module L = List in L.length (L.map succ x);; - -module F(X:sig end) = Char;; -module C4 = F(struct end);; -C4.chr 66;; - -module G(X:sig end) = struct module M = X end;; (* does not alias X *) -module M = G(struct end);; - -module M' = struct - module N = struct let x = 1 end - module N' = N -end;; -M'.N'.x;; - -module M'' : sig module N' : sig val x : int end end = M';; -M''.N'.x;; -module M2 = struct include M' end;; -module M3 : sig module N' : sig val x : int end end = struct include M' end;; -M3.N'.x;; -module M3' : sig module N' : sig val x : int end end = M2;; -M3'.N'.x;; - -module M4 : sig module N' : sig val x : int end end = struct - module N = struct let x = 1 end - module N' = N -end;; -M4.N'.x;; - -module F(X:sig end) = struct - module N = struct let x = 1 end - module N' = N -end;; -module G : functor(X:sig end) -> sig module N' : sig val x : int end end = F;; -module M5 = G(struct end);; -M5.N'.x;; - -module M = struct - module D = struct let y = 3 end - module N = struct let x = 1 end - module N' = N -end;; - -module M1 : sig module N : sig val x : int end module N' = N end = M;; -M1.N'.x;; -module M2 : sig module N' : sig val x : int end end = - (M : sig module N : sig val x : int end module N' = N end);; -M2.N'.x;; - -open M;; -N'.x;; - -module M = struct - module C = Char - module C' = C -end;; -module M1 - : sig module C : sig val escaped : char -> string end module C' = C end - = M;; (* sound, but should probably fail *) -M1.C'.escaped 'A';; -module M2 : sig module C' : sig val chr : int -> char end end = - (M : sig module C : sig val chr : int -> char end module C' = C end);; -M2.C'.chr 66;; - -StdLabels.List.map;; - -module Q = Queue;; -exception QE = Q.Empty;; -try Q.pop (Q.create ()) with QE -> "Ok";; - -module type Complex = module type of Complex with type t = Complex.t;; -module M : sig module C : Complex end = struct module C = Complex end;; - -module C = Complex;; -C.one.Complex.re;; -include C;; - -module F(X:sig module C = Char end) = struct module C = X.C end;; - -(* Applicative functors *) -module S = String -module StringSet = Set.Make(String) -module SSet = Set.Make(S);; -let f (x : StringSet.t) = (x : SSet.t);; - -(* Also using include (cf. Leo's mail 2013-11-16) *) -module F (M : sig end) : sig type t end = struct type t = int end -module T = struct - module M = struct end - include F(M) -end;; -include T;; -let f (x : t) : T.t = x ;; - -(* PR#4049 *) -(* This works thanks to abbreviations *) -module A = struct - module B = struct type t let compare x y = 0 end - module S = Set.Make(B) - let empty = S.empty -end -module A1 = A;; -A1.empty = A.empty;; - -(* PR#3476 *) -(* Does not work yet *) -module FF(X : sig end) = struct type t end -module M = struct - module X = struct end - module Y = FF (X) (* XXX *) - type t = Y.t -end -module F (Y : sig type t end) (M : sig type t = Y.t end) = struct end;; - -module G = F (M.Y);; -(*module N = G (M);; -module N = F (M.Y) (M);;*) - -(* PR#6307 *) - -module A1 = struct end -module A2 = struct end -module L1 = struct module X = A1 end -module L2 = struct module X = A2 end;; - -module F (L : (module type of L1)) = struct end;; - -module F1 = F(L1);; (* ok *) -module F2 = F(L2);; (* should succeed too *) - -(* Counter example: why we need to be careful with PR#6307 *) -module Int = struct type t = int let compare = compare end -module SInt = Set.Make(Int) -type (_,_) eq = Eq : ('a,'a) eq -type wrap = W of (SInt.t, SInt.t) eq - -module M = struct - module I = Int - type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(I).t) eq -end;; -module type S = module type of M;; (* keep alias *) - -module Int2 = struct type t = int let compare x y = compare y x end;; -module type S' = sig - module I = Int2 - include S with module I := I -end;; (* fail *) - -(* (* if the above succeeded, one could break invariants *) -module rec M2 : S' = M2;; (* should succeed! (but this is bad) *) - -let M2.W eq = W Eq;; - -let s = List.fold_right SInt.add [1;2;3] SInt.empty;; -module SInt2 = Set.Make(Int2);; -let conv : type a b. (a,b) eq -> a -> b = fun Eq x -> x;; -let s' : SInt2.t = conv eq s;; -SInt2.elements s';; -SInt2.mem 2 s';; (* invariants are broken *) -*) - -(* Check behavior with submodules *) -module M = struct - module N = struct module I = Int end - module P = struct module I = N.I end - module Q = struct - type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(P.I).t) eq - end -end;; -module type S = module type of M ;; - -module M = struct - module N = struct module I = Int end - module P = struct module I = N.I end - module Q = struct - type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(N.I).t) eq - end -end;; -module type S = module type of M ;; - -(* PR#6365 *) -module type S = sig module M : sig type t val x : t end end;; -module H = struct type t = A let x = A end;; -module H' = H;; -module type S' = S with module M = H';; (* shouldn't introduce an alias *) - -(* PR#6376 *) -module type Alias = sig module N : sig end module M = N end;; -module F (X : sig end) = struct type t end;; -module type A = Alias with module N := F(List);; -module rec Bad : A = Bad;; - -(* Shinwell 2014-04-23 *) -module B = struct - module R = struct - type t = string - end - - module O = R -end - -module K = struct - module E = B - module N = E.O -end;; - -let x : K.N.t = "foo";; - -(* PR#6465 *) - -module M = struct type t = A module B = struct type u = B end end;; -module P : sig type t = M.t = A module B = M.B end = M;; (* should be ok *) -module P : sig type t = M.t = A module B = M.B end = struct include M end;; - -module type S = sig - module M : sig module P : sig end end - module Q = M -end;; -module type S = sig - module M : sig module N : sig end module P : sig end end - module Q : sig module N = M.N module P = M.P end -end;; -module R = struct - module M = struct module N = struct end module P = struct end end - module Q = M -end;; -module R' : S = R;; (* should be ok *) - -(* PR#6578 *) - -module M = struct let f x = x end -module rec R : sig module M : sig val f : 'a -> 'a end end = - struct module M = M end;; -R.M.f 3;; -module rec R : sig module M = M end = struct module M = M end;; -R.M.f 3;; -open A -let f = - L.map S.capitalize - -let () = - L.iter print_endline (f ["jacques"; "garrigue"]) - -module C : sig module L : module type of List end = struct include A end - -(* The following introduces a (useless) dependency on A: -module C : sig module L : module type of List end = A -*) - -include D' -(* -let () = - print_endline (string_of_int D'.M.y) -*) -open A -let f = - L.map S.capitalize - -let () = - L.iter print_endline (f ["jacques"; "garrigue"]) - -module C : sig module L : module type of List end = struct include A end - -(* The following introduces a (useless) dependency on A: -module C : sig module L : module type of List end = A -*) - -(* No dependency on D *) -let x = 3 -module M = struct let y = 5 end -module type S = sig type u type t end;; -module type S' = sig type t = int type u = bool end;; - -(* ok to convert between structurally equal signatures, and parameters - are inferred *) -let f (x : (module S with type t = 'a and type u = 'b)) = (x : (module S'));; -let g x = (x : (module S with type t = 'a and type u = 'b) :> (module S'));; - -(* with subtyping it is also ok to forget some types *) -module type S2 = sig type u type t type w end;; -let g2 x = (x : (module S2 with type t = 'a and type u = 'b) :> (module S'));; -let h x = (x : (module S2 with type t = 'a) :> (module S with type t = 'a));; -let f2 (x : (module S2 with type t = 'a and type u = 'b)) = - (x : (module S'));; (* fail *) -let k (x : (module S2 with type t = 'a)) = - (x : (module S with type t = 'a));; (* fail *) - -(* but you cannot forget values (no physical coercions) *) -module type S3 = sig type u type t val x : int end;; -let g3 x = - (x : (module S3 with type t = 'a and type u = 'b) :> (module S'));; (* fail *) -(* Using generative functors *) - -(* Without type *) -module type S = sig val x : int end;; -let v = (module struct let x = 3 end : S);; -module F() = (val v);; (* ok *) -module G (X : sig end) : S = F ();; (* ok *) -module H (X : sig end) = (val v);; (* ok *) - -(* With type *) -module type S = sig type t val x : t end;; -let v = (module struct type t = int let x = 3 end : S);; -module F() = (val v);; (* ok *) -module G (X : sig end) : S = F ();; (* fail *) -module H() = F();; (* ok *) - -(* Alias *) -module U = struct end;; -module M = F(struct end);; (* ok *) -module M = F(U);; (* fail *) - -(* Cannot coerce between applicative and generative *) -module F1 (X : sig end) = struct end;; -module F2 : functor () -> sig end = F1;; (* fail *) -module F3 () = struct end;; -module F4 : functor (X : sig end) -> sig end = F3;; (* fail *) - -(* tests for shortened functor notation () *) -module X (X: sig end) (Y: sig end) = functor (Z: sig end) -> struct end;; -module Y = functor (X: sig end) (Y:sig end) -> functor (Z: sig end) -> - struct end;; -module Z = functor (_: sig end) (_:sig end) (_: sig end) -> struct end;; -module GZ : functor (X: sig end) () (Z: sig end) -> sig end - = functor (X: sig end) () (Z: sig end) -> struct end;; -module F (X : sig end) = struct type t = int end;; -type t = F(Does_not_exist).t;; -type expr = - [ `Abs of string * expr - | `App of expr * expr - ] - -class type exp = -object - method eval : (string, exp) Hashtbl.t -> expr -end;; - -class app e1 e2 : exp = -object - val l = e1 - val r = e2 - method eval env = - match l with - | `Abs(var,body) -> - Hashtbl.add env var r; - body - | _ -> `App(l,r); -end - -class virtual ['subject, 'event] observer = - object - method virtual notify : 'subject -> 'event -> unit - end - -class ['event] subject = - object (self : 'subject) - val mutable observers = ([]: (('subject, 'event) observer) list) - method add_observer obs = observers <- (obs :: observers) - method notify_observers (e : 'event) = - List.iter (fun x -> x#notify self e) observers - end - -type id = int - -class entity (id : id) = - object - val ent_destroy_subject = new subject - method destroy_subject : (id) subject = ent_destroy_subject - - method entity_id = id - end - -class ['entity] entity_container = - object (self) - inherit ['entity, id] observer as observer - - method add_entity (e : 'entity) = - e#destroy_subject#add_observer (self) - - method notify _ id = () - end - -let f (x : entity entity_container) = () - -(* -class world = - object - val entity_container : entity entity_container = new entity_container - - method add_entity (s : entity) = - entity_container#add_entity (s :> entity) - - end -*) -(* Two v's in the same class *) -class c v = object initializer print_endline v val v = 42 end;; -new c "42";; - -(* Two hidden v's in the same class! *) -class c (v : int) = - object - method v0 = v - inherit ((fun v -> object method v : string = v end) "42") - end;; -(new c 42)#v0;; -class virtual ['a] c = -object (s : 'a) - method virtual m : 'b -end - -let o = - object (s :'a) - inherit ['a] c - method m = 42 - end -module M : - sig - class x : int -> object method m : int end - end -= -struct - class x _ = object - method m = 42 - end -end;; -module M : sig class c : 'a -> object val x : 'b end end = - struct class c x = object val x = x end end - -class c (x : int) = object inherit M.c x method x : bool = x end - -let r = (new c 2)#x;; -(* test.ml *) -class alfa = object(_:'self) - method x: 'a. ('a, out_channel, unit) format -> 'a = Printf.printf -end - -class bravo a = object - val y = (a :> alfa) - initializer y#x "bravo initialized" -end - -class charlie a = object - inherit bravo a - initializer y#x "charlie initialized" -end -(* The module begins *) -exception Out_of_range - -class type ['a] cursor = - object - method get : 'a - method incr : unit -> unit - method is_last : bool - end - -class type ['a] storage = - object ('self) - method first : 'a cursor - method len : int - method nth : int -> 'a cursor - method copy : 'self - method sub : int -> int -> 'self - method concat : 'a storage -> 'self - method fold : 'b. ('a -> int -> 'b -> 'b) -> 'b -> 'b - method iter : ('a -> unit) -> unit - end - -class virtual ['a, 'cursor] storage_base = - object (self : 'self) - constraint 'cursor = 'a #cursor - method virtual first : 'cursor - method virtual len : int - method virtual copy : 'self - method virtual sub : int -> int -> 'self - method virtual concat : 'a storage -> 'self - method fold : 'b. ('a -> int -> 'b -> 'b) -> 'b -> 'b = fun f a0 -> - let cur = self#first in - let rec loop count a = - if count >= self#len then a else - let a' = f cur#get count a in - cur#incr (); loop (count + 1) a' - in - loop 0 a0 - method iter proc = - let p = self#first in - for i = 0 to self#len - 2 do proc p#get; p#incr () done; - if self#len > 0 then proc p#get else () - end - -class type ['a] obj_input_channel = - object - method get : unit -> 'a - method close : unit -> unit - end - -class type ['a] obj_output_channel = - object - method put : 'a -> unit - method flush : unit -> unit - method close : unit -> unit - end - -module UChar = -struct - - type t = int - - let highest_bit = 1 lsl 30 - let lower_bits = highest_bit - 1 - - let char_of c = - try Char.chr c with Invalid_argument _ -> raise Out_of_range - - let of_char = Char.code - - let code c = - if c lsr 30 = 0 - then c - else raise Out_of_range - - let chr n = - if n >= 0 && (n lsr 31 = 0) then n else raise Out_of_range - - let uint_code c = c - let chr_of_uint n = n - -end - -type uchar = UChar.t - -let int_of_uchar u = UChar.uint_code u -let uchar_of_int n = UChar.chr_of_uint n - -class type ucursor = [uchar] cursor - -class type ustorage = [uchar] storage - -class virtual ['ucursor] ustorage_base = [uchar, 'ucursor] storage_base - -module UText = -struct - -(* the internal representation is UCS4 with big endian*) -(* The most significant digit appears first. *) -let get_buf s i = - let n = Char.code s.[i] in - let n = (n lsl 8) lor (Char.code s.[i + 1]) in - let n = (n lsl 8) lor (Char.code s.[i + 2]) in - let n = (n lsl 8) lor (Char.code s.[i + 3]) in - UChar.chr_of_uint n - -let set_buf s i u = - let n = UChar.uint_code u in - begin - s.[i] <- Char.chr (n lsr 24); - s.[i + 1] <- Char.chr (n lsr 16 lor 0xff); - s.[i + 2] <- Char.chr (n lsr 8 lor 0xff); - s.[i + 3] <- Char.chr (n lor 0xff); - end - -let init_buf buf pos init = - if init#len = 0 then () else - let cur = init#first in - for i = 0 to init#len - 2 do - set_buf buf (pos + i lsl 2) (cur#get); cur#incr () - done; - set_buf buf (pos + (init#len - 1) lsl 2) (cur#get) - -let make_buf init = - let s = String.create (init#len lsl 2) in - init_buf s 0 init; s - -class text_raw buf = - object (self : 'self) - inherit [cursor] ustorage_base - val contents = buf - method first = new cursor (self :> text_raw) 0 - method len = (String.length contents) / 4 - method get i = get_buf contents (4 * i) - method nth i = new cursor (self :> text_raw) i - method copy = {< contents = String.copy contents >} - method sub pos len = - {< contents = String.sub contents (pos * 4) (len * 4) >} - method concat (text : ustorage) = - let buf = String.create (String.length contents + 4 * text#len) in - String.blit contents 0 buf 0 (String.length contents); - init_buf buf (String.length contents) text; - {< contents = buf >} - end -and cursor text i = - object - val contents = text - val mutable pos = i - method get = contents#get pos - method incr () = pos <- pos + 1 - method is_last = (pos + 1 >= contents#len) - end - -class string_raw buf = - object - inherit text_raw buf - method set i u = set_buf contents (4 * i) u - end - -class text init = text_raw (make_buf init) -class string init = string_raw (make_buf init) - -let of_string s = - let buf = String.make (4 * String.length s) '\000' in - for i = 0 to String.length s - 1 do - buf.[4 * i] <- s.[i] - done; - new text_raw buf - -let make len u = - let s = String.create (4 * len) in - for i = 0 to len - 1 do set_buf s (4 * i) u done; - new string_raw s - -let create len = make len (UChar.chr 0) - -let copy s = s#copy - -let sub s start len = s#sub start len - -let fill s start len u = - for i = start to start + len - 1 do s#set i u done - -let blit src srcoff dst dstoff len = - for i = 0 to len - 1 do - let u = src#get (srcoff + i) in - dst#set (dstoff + i) u - done - -let concat s1 s2 = s1#concat (s2 (* : #ustorage *) :> uchar storage) - -let iter proc s = s#iter proc -end -class type foo_t = - object - method foo: string - end - -type 'a name = - Foo: foo_t name - | Int: int name -;; - -class foo = - object(self) - method foo = "foo" - method cast = - function - Foo -> (self :> <foo : string>) - end -;; - -class foo: foo_t = - object(self) - method foo = "foo" - method cast: type a. a name -> a = - function - Foo -> (self :> foo_t) - | _ -> raise Exit - end -;; -class type c = object end;; -module type S = sig class c: c end;; -class virtual name = -object -end - -and func (args_ty, ret_ty) = -object(self) - inherit name - - val mutable memo_args = None - - method arguments = - match memo_args with - | Some xs -> xs - | None -> - let args = List.map (fun ty -> new argument(self, ty)) args_ty in - memo_args <- Some args; args -end - -and argument (func, ty) = -object - inherit name -end -;; -let f (x: #M.foo) = 0;; -class type ['e] t = object('s) - method update : 'e -> 's -end;; - -module type S = sig - class base : 'e -> ['e] t -end;; -type 'par t = 'par -module M : sig val x : <m : 'a. 'a> end = - struct let x : <m : 'a. 'a t> = Obj.magic () end - -let ident v = v -class alias = object method alias : 'a . 'a t -> 'a = ident end -module Classdef = struct - class virtual ['a, 'b, 'c] cl0 = - object - constraint 'c = < m : 'a -> 'b -> int; .. > - end - - class virtual ['a, 'b] cl1 = - object - method virtual raise_trouble : int -> 'a - method virtual m : 'a -> 'b -> int - end - - class virtual ['a, 'b] cl2 = - object - method virtual as_cl0 : ('a, 'b, ('a, 'b) cl1) cl0 - end -end - -type refer1 = < poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) > -type refer2 = < poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) > - -(* Actually this should succeed ... *) -let f (x : refer1) = (x : refer2) -module Classdef = struct - class virtual ['a, 'b, 'c] cl0 = - object - constraint 'c = < m : 'a -> 'b -> int; .. > - end - - class virtual ['a, 'b] cl1 = - object - method virtual raise_trouble : int -> 'a - method virtual m : 'a -> 'b -> int - end - - class virtual ['a, 'b] cl2 = - object - method virtual as_cl0 : ('a, 'b, ('a, 'b) cl1) cl0 - end -end - -module M : sig - type refer = { poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) } -end = struct - type refer = { poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) } -end -(* - ocamlc -c pr3918a.mli pr3918b.mli - rm -f pr3918a.cmi - ocamlc -c pr3918c.ml -*) - -open Pr3918b - -let f x = (x : 'a vlist :> 'b vlist) -let f (x : 'a vlist) = (x : 'b vlist) -module type Poly = sig - type 'a t = 'a constraint 'a = [> ] -end - -module Combine (A : Poly) (B : Poly) = struct - type ('a, 'b) t = 'a A.t constraint 'a = 'b B.t -end - -module C = Combine - (struct type 'a t = 'a constraint 'a = [> ] end) - (struct type 'a t = 'a constraint 'a = [> ] end) -module type Priv = sig - type t = private int -end - -module Make (Unit:sig end): Priv = struct type t = int end - -module A = Make (struct end) - -module type Priv' = sig - type t = private [> `A] -end - -module Make' (Unit:sig end): Priv' = struct type t = [`A] end - -module A' = Make' (struct end) -(* PR5057 *) - -module TT = struct - module IntSet = Set.Make(struct type t = int let compare = compare end) -end - -let () = - let f flag = - let module T = TT in - let _ = match flag with `A -> 0 | `B r -> r in - let _ = match flag with `A -> T.IntSet.mem | `B r -> r in - () - in - f `A -(* This one should fail *) - -let f flag = - let module T = Set.Make(struct type t = int let compare = compare end) in - let _ = match flag with `A -> 0 | `B r -> r in - let _ = match flag with `A -> T.mem | `B r -> r in - () -module type S = sig - type +'a t - - val foo : [`A] t -> unit - val bar : [< `A | `B] t -> unit -end - -module Make(T : S) = struct - let f x = - T.foo x; - T.bar x; - (x :> [`A | `C] T.t) -end -type 'a termpc = - [`And of 'a * 'a - |`Or of 'a * 'a - |`Not of 'a - |`Atom of string - ] - -type 'a termk = - [`Dia of 'a - |`Box of 'a - |'a termpc - ] - -module type T = sig - type term - val map : (term -> term) -> term -> term - val nnf : term -> term - val nnf_not : term -> term -end - -module Fpc(X : T with type term = private [> 'a termpc] as 'a) = - struct - type term = X.term termpc - let nnf = function - |`Not(`Atom _) as x -> x - |`Not x -> X.nnf_not x - | x -> X.map X.nnf x - let map f : term -> X.term = function - |`Not x -> `Not (f x) - |`And(x,y) -> `And (f x, f y) - |`Or (x,y) -> `Or (f x, f y) - |`Atom _ as x -> x - let nnf_not : term -> _ = function - |`Not x -> X.nnf x - |`And(x,y) -> `Or (X.nnf_not x, X.nnf_not y) - |`Or (x,y) -> `And (X.nnf_not x, X.nnf_not y) - |`Atom _ as x -> `Not x - end - -module Fk(X : T with type term = private [> 'a termk] as 'a) = - struct - type term = X.term termk - module Pc = Fpc(X) - let map f : term -> _ = function - |`Dia x -> `Dia (f x) - |`Box x -> `Box (f x) - |#termpc as x -> Pc.map f x - let nnf = Pc.nnf - let nnf_not : term -> _ = function - |`Dia x -> `Box (X.nnf_not x) - |`Box x -> `Dia (X.nnf_not x) - |#termpc as x -> Pc.nnf_not x - end -type untyped;; -type -'a typed = private untyped;; -type -'typing wrapped = private sexp -and +'a t = 'a typed wrapped -and sexp = private untyped wrapped;; -class type ['a] s3 = object - val underlying : 'a t -end;; -class ['a] s3object r : ['a] s3 = object - val underlying = r -end;; -module M (T:sig type t end) - = struct type t = private { t : T.t } end -module P - = struct - module T = struct type t end - module R = M(T) - end -module Foobar : sig - type t = private int -end = struct - type t = int -end;; - -module F0 : sig type t = private int end = Foobar;; - -let f (x : F0.t) = (x : Foobar.t);; (* fails *) - -module F = Foobar;; - -let f (x : F.t) = (x : Foobar.t);; - -module M = struct type t = <m:int> end;; -module M1 : sig type t = private <m:int; ..> end = M;; -module M2 : sig type t = private <m:int; ..> end = M1;; -fun (x : M1.t) -> (x : M2.t);; (* fails *) - -module M3 : sig type t = private M1.t end = M1;; -fun x -> (x : M3.t :> M1.t);; -fun x -> (x : M3.t :> M.t);; -module M4 : sig type t = private M3.t end = M2;; (* fails *) -module M4 : sig type t = private M3.t end = M;; (* fails *) -module M4 : sig type t = private M3.t end = M1;; (* might be ok *) -module M5 : sig type t = private M1.t end = M3;; -module M6 : sig type t = private < n:int; .. > end = M1;; (* fails *) - -module Bar : sig type t = private Foobar.t val f : int -> t end = - struct type t = int let f (x : int) = (x : t) end;; (* must fail *) - -module M : sig - type t = private T of int - val mk : int -> t -end = struct - type t = T of int - let mk x = T(x) -end;; - -module M1 : sig - type t = M.t - val mk : int -> t -end = struct - type t = M.t - let mk = M.mk -end;; - -module M2 : sig - type t = M.t - val mk : int -> t -end = struct - include M -end;; - -module M3 : sig - type t = M.t - val mk : int -> t -end = M;; - -module M4 : sig - type t = M.t = T of int - val mk : int -> t - end = M;; -(* Error: The variant or record definition does not match that of type M.t *) - -module M5 : sig - type t = M.t = private T of int - val mk : int -> t -end = M;; - -module M6 : sig - type t = private T of int - val mk : int -> t -end = M;; - -module M' : sig - type t_priv = private T of int - type t = t_priv - val mk : int -> t -end = struct - type t_priv = T of int - type t = t_priv - let mk x = T(x) -end;; - -module M3' : sig - type t = M'.t - val mk : int -> t -end = M';; - -module M : sig type 'a t = private T of 'a end = - struct type 'a t = T of 'a end;; - -module M1 : sig type 'a t = 'a M.t = private T of 'a end = - struct type 'a t = 'a M.t = private T of 'a end;; - -(* PR#6090 *) -module Test = struct type t = private A end -module Test2 : module type of Test with type t = Test.t = Test;; -let f (x : Test.t) = (x : Test2.t);; -let f Test2.A = ();; -let a = Test2.A;; (* fail *) -(* The following should fail from a semantical point of view, - but allow it for backward compatibility *) -module Test2 : module type of Test with type t = private Test.t = Test;; - -(* PR#6331 *) -type t = private < x : int; .. > as 'a;; -type t = private (< x : int; .. > as 'a) as 'a;; -type t = private < x : int > as 'a;; -type t = private (< x : int > as 'a) as 'b;; -type 'a t = private < x : int; .. > as 'a;; -type 'a t = private 'a constraint 'a = < x : int; .. >;; -(* Bad (t = t) *) -module rec A : sig type t = A.t end = struct type t = A.t end;; -(* Bad (t = t) *) -module rec A : sig type t = B.t end = struct type t = B.t end - and B : sig type t = A.t end = struct type t = A.t end;; -(* OK (t = int) *) -module rec A : sig type t = B.t end = struct type t = B.t end - and B : sig type t = int end = struct type t = int end;; -(* Bad (t = int * t) *) -module rec A : sig type t = int * A.t end = struct type t = int * A.t end;; -(* Bad (t = t -> int) *) -module rec A : sig type t = B.t -> int end = struct type t = B.t -> int end - and B : sig type t = A.t end = struct type t = A.t end;; -(* OK (t = <m:t>) *) -module rec A : sig type t = <m:B.t> end = struct type t = <m:B.t> end - and B : sig type t = A.t end = struct type t = A.t end;; -(* Bad (not regular) *) -module rec A : sig type 'a t = <m: 'a list A.t> end - = struct type 'a t = <m: 'a list A.t> end;; -(* Bad (not regular) *) -module rec A : sig type 'a t = <m: 'a list B.t; n: 'a array B.t> end - = struct type 'a t = <m: 'a list B.t; n: 'a array B.t> end - and B : sig type 'a t = 'a A.t end = struct type 'a t = 'a A.t end;; -(* Bad (not regular) *) -module rec A : sig type 'a t = 'a B.t end - = struct type 'a t = 'a B.t end - and B : sig type 'a t = <m: 'a list A.t; n: 'a array A.t> end - = struct type 'a t = <m: 'a list A.t; n: 'a array A.t> end;; -(* OK *) -module rec A : sig type 'a t = 'a array B.t * 'a list B.t end - = struct type 'a t = 'a array B.t * 'a list B.t end - and B : sig type 'a t = <m: 'a B.t> end - = struct type 'a t = <m: 'a B.t> end;; -(* Bad (not regular) *) -module rec A : sig type 'a t = 'a list B.t end - = struct type 'a t = 'a list B.t end - and B : sig type 'a t = <m: 'a array B.t> end - = struct type 'a t = <m: 'a array B.t> end;; -(* Bad (not regular) *) -module rec M : - sig - class ['a] c : 'a -> object - method map : ('a -> 'b) -> 'b M.c - end - end - = struct - class ['a] c (x : 'a) = object - method map : 'b. ('a -> 'b) -> 'b M.c - = fun f -> new M.c (f x) - end - end;; -(* OK *) -class type [ 'node ] extension = object method node : 'node end -and [ 'ext ] node = object constraint 'ext = 'ext node #extension [@id] end -class x = object method node : x node = assert false end -type t = x node;; -(* Bad - PR 4261 *) - -module PR_4261 = struct - module type S = - sig - type t - end - - module type T = - sig - module D : S - type t = D.t - end - - module rec U : T with module D = U' = U - and U' : S with type t = U'.t = U -end;; -(* Bad - PR 4512 *) -module type S' = sig type t = int end -module rec M : S' with type t = M.t = struct type t = M.t end;; -(* PR#4450 *) - -module PR_4450_1 = struct - module type MyT = sig type 'a t = Succ of 'a t end - module MyMap(X : MyT) = X - module rec MyList : MyT = MyMap(MyList) -end;; - -module PR_4450_2 = struct - module type MyT = sig - type 'a wrap = My of 'a t - and 'a t = private < map : 'b. ('a -> 'b) ->'b wrap; .. > - val create : 'a list -> 'a t - end - module MyMap(X : MyT) = struct - include X - class ['a] c l = object (self) - method map : 'b. ('a -> 'b) -> 'b wrap = - fun f -> My (create (List.map f l)) - end - end - module rec MyList : sig - type 'a wrap = My of 'a t - and 'a t = < map : 'b. ('a -> 'b) ->'b wrap > - val create : 'a list -> 'a t - end = struct - include MyMap(MyList) - let create l = new c l - end -end;; -(* A synthetic example of bootstrapped data structure - (suggested by J-C Filliatre) *) - -module type ORD = sig - type t - val compare : t -> t -> int -end - -module type SET = sig - type elt - type t - val iter : (elt -> unit) -> t -> unit -end - -type 'a tree = E | N of 'a tree * 'a * 'a tree - -module Bootstrap2 - (MakeDiet : functor (X: ORD) -> SET with type t = X.t tree and type elt = X.t) - : SET with type elt = int = -struct - - type elt = int - - module rec Elt : sig - type t = I of int * int | D of int * Diet.t * int - val compare : t -> t -> int - val iter : (int -> unit) -> t -> unit - end = - struct - type t = I of int * int | D of int * Diet.t * int - let compare x1 x2 = 0 - let rec iter f = function - | I (l, r) -> for i = l to r do f i done - | D (_, d, _) -> Diet.iter (iter f) d - end - - and Diet : SET with type t = Elt.t tree and type elt = Elt.t = MakeDiet(Elt) - - type t = Diet.t - let iter f = Diet.iter (Elt.iter f) -end -(* PR 4470: simplified from OMake's sources *) - -module rec DirElt - : sig - type t = DirRoot | DirSub of DirHash.t - end - = struct - type t = DirRoot | DirSub of DirHash.t - end - -and DirCompare - : sig - type t = DirElt.t - end - = struct - type t = DirElt.t - end - -and DirHash - : sig - type t = DirElt.t list - end - = struct - type t = DirCompare.t list - end -(* PR 4758, PR 4266 *) - -module PR_4758 = struct - module type S = sig end - module type Mod = sig - module Other : S - end - module rec A : S = struct end - and C : sig include Mod with module Other = A end = struct - module Other = A - end - module C' = C (* check that we can take an alias *) - module F(X:sig end) = struct type t end - let f (x : F(C).t) = (x : F(C').t) -end -(* PR 4557 *) -module PR_4557 = struct - module F ( X : Set.OrderedType ) = struct - module rec Mod : sig - module XSet : - sig - type elt = X.t - type t = Set.Make( X ).t - end - module XMap : - sig - type key = X.t - type 'a t = 'a Map.Make(X).t - end - type elt = X.t - type t = XSet.t XMap.t - val compare: t -> t -> int - end - = - struct - module XSet = Set.Make( X ) - module XMap = Map.Make( X ) - - type elt = X.t - type t = XSet.t XMap.t - let compare = (fun x y -> 0) - end - and ModSet : Set.S with type elt = Mod.t = Set.Make( Mod ) - end -end -module F ( X : Set.OrderedType ) = struct - module rec Mod : sig - module XSet : - sig - type elt = X.t - type t = Set.Make( X ).t - end - module XMap : - sig - type key = X.t - type 'a t = 'a Map.Make(X).t - end - type elt = X.t - type t = XSet.t XMap.t - val compare: t -> t -> int - end - = - struct - module XSet = Set.Make( X ) - module XMap = Map.Make( X ) - - type elt = X.t - type t = XSet.t XMap.t - let compare = (fun x y -> 0) - end - and ModSet : Set.S with type elt = Mod.t = Set.Make( Mod ) -end -(* Tests for recursive modules *) - -let test number result expected = - if result = expected - then Printf.printf "Test %d passed.\n" number - else Printf.printf "Test %d FAILED.\n" number; - flush stdout - -(* Tree of sets *) - -module rec A - : sig - type t = Leaf of int | Node of ASet.t - val compare: t -> t -> int - end - = struct - type t = Leaf of int | Node of ASet.t - let compare x y = - match (x,y) with - (Leaf i, Leaf j) -> Pervasives.compare i j - | (Leaf i, Node t) -> -1 - | (Node s, Leaf j) -> 1 - | (Node s, Node t) -> ASet.compare s t - end - -and ASet : Set.S with type elt = A.t = Set.Make(A) -;; - -let _ = - let x = A.Node (ASet.add (A.Leaf 3) (ASet.singleton (A.Leaf 2))) in - let y = A.Node (ASet.add (A.Leaf 1) (ASet.singleton x)) in - test 10 (A.compare x x) 0; - test 11 (A.compare x (A.Leaf 3)) 1; - test 12 (A.compare (A.Leaf 0) x) (-1); - test 13 (A.compare y y) 0; - test 14 (A.compare x y) 1 -;; - -(* Simple value recursion *) - -module rec Fib - : sig val f : int -> int end - = struct let f x = if x < 2 then 1 else Fib.f(x-1) + Fib.f(x-2) end -;; - -let _ = - test 20 (Fib.f 10) 89 -;; - -(* Update function by infix *) - -module rec Fib2 - : sig val f : int -> int end - = struct let rec g x = Fib2.f(x-1) + Fib2.f(x-2) - and f x = if x < 2 then 1 else g x - end -;; - -let _ = - test 21 (Fib2.f 10) 89 -;; - -(* Early application *) - -let _ = - let res = - try - let module A = - struct - module rec Bad - : sig val f : int -> int end - = struct let f = let y = Bad.f 5 in fun x -> x+y end - end in - false - with Undefined_recursive_module _ -> - true in - test 30 res true -;; - -(* Early strict evaluation *) - -(* -module rec Cyclic - : sig val x : int end - = struct let x = Cyclic.x + 1 end -;; -*) - -(* Reordering of evaluation based on dependencies *) - -module rec After - : sig val x : int end - = struct let x = Before.x + 1 end -and Before - : sig val x : int end - = struct let x = 3 end -;; - -let _ = - test 40 After.x 4 -;; - -(* Type identity between A.t and t within A's definition *) - -module rec Strengthen - : sig type t val f : t -> t end - = struct - type t = A | B - let _ = (A : Strengthen.t) - let f x = if true then A else Strengthen.f B - end -;; - -module rec Strengthen2 - : sig type t - val f : t -> t - module M : sig type u end - module R : sig type v end - end - = struct - type t = A | B - let _ = (A : Strengthen2.t) - let f x = if true then A else Strengthen2.f B - module M = - struct - type u = C - let _ = (C: Strengthen2.M.u) - end - module rec R : sig type v = Strengthen2.R.v end = - struct - type v = D - let _ = (D : R.v) - let _ = (D : Strengthen2.R.v) - end - end -;; - -(* Polymorphic recursion *) - -module rec PolyRec - : sig - type 'a t = Leaf of 'a | Node of 'a list t * 'a list t - val depth: 'a t -> int - end - = struct - type 'a t = Leaf of 'a | Node of 'a list t * 'a list t - let x = (PolyRec.Leaf 1 : int t) - let depth = function - Leaf x -> 0 - | Node(l,r) -> 1 + max (PolyRec.depth l) (PolyRec.depth r) - end -;; - -(* Wrong LHS signatures (PR#4336) *) - -(* -module type ASig = sig type a val a:a val print:a -> unit end -module type BSig = sig type b val b:b val print:b -> unit end - -module A = struct type a = int let a = 0 let print = print_int end -module B = struct type b = float let b = 0.0 let print = print_float end - -module MakeA (Empty:sig end) : ASig = A -module MakeB (Empty:sig end) : BSig = B - -module - rec NewA : ASig = MakeA (struct end) - and NewB : BSig with type b = NewA.a = MakeB (struct end);; - -*) - -(* Expressions and bindings *) - -module StringSet = Set.Make(String);; - -module rec Expr - : sig - type t = - Var of string - | Const of int - | Add of t * t - | Binding of Binding.t * t - val make_let: string -> t -> t -> t - val fv: t -> StringSet.t - val simpl: t -> t - end - = struct - type t = - Var of string - | Const of int - | Add of t * t - | Binding of Binding.t * t - let make_let id e1 e2 = Binding([id, e1], e2) - let rec fv = function - Var s -> StringSet.singleton s - | Const n -> StringSet.empty - | Add(t1,t2) -> StringSet.union (fv t1) (fv t2) - | Binding(b,t) -> - StringSet.union (Binding.fv b) - (StringSet.diff (fv t) (Binding.bv b)) - let rec simpl = function - Var s -> Var s - | Const n -> Const n - | Add(Const i, Const j) -> Const (i+j) - | Add(Const 0, t) -> simpl t - | Add(t, Const 0) -> simpl t - | Add(t1,t2) -> Add(simpl t1, simpl t2) - | Binding(b, t) -> Binding(Binding.simpl b, simpl t) - end - -and Binding - : sig - type t = (string * Expr.t) list - val fv: t -> StringSet.t - val bv: t -> StringSet.t - val simpl: t -> t - end - = struct - type t = (string * Expr.t) list - let fv b = - List.fold_left (fun v (id,e) -> StringSet.union v (Expr.fv e)) - StringSet.empty b - let bv b = - List.fold_left (fun v (id,e) -> StringSet.add id v) - StringSet.empty b - let simpl b = - List.map (fun (id,e) -> (id, Expr.simpl e)) b - end -;; - -let _ = - let e = Expr.make_let "x" (Expr.Add (Expr.Var "y", Expr.Const 0)) - (Expr.Var "x") in - let e' = Expr.make_let "x" (Expr.Var "y") (Expr.Var "x") in - test 50 (StringSet.elements (Expr.fv e)) ["y"]; - test 51 (Expr.simpl e) e' -;; - -(* Okasaki's bootstrapping *) - -module type ORDERED = - sig - type t - val eq: t -> t -> bool - val lt: t -> t -> bool - val leq: t -> t -> bool - end - -module type HEAP = - sig - module Elem: ORDERED - type heap - val empty: heap - val isEmpty: heap -> bool - val insert: Elem.t -> heap -> heap - val merge: heap -> heap -> heap - val findMin: heap -> Elem.t - val deleteMin: heap -> heap - end - -module Bootstrap (MakeH: functor (Element:ORDERED) -> - HEAP with module Elem = Element) - (Element: ORDERED) : HEAP with module Elem = Element = - struct - module Elem = Element - module rec BE - : sig type t = E | H of Elem.t * PrimH.heap - val eq: t -> t -> bool - val lt: t -> t -> bool - val leq: t -> t -> bool - end - = struct - type t = E | H of Elem.t * PrimH.heap - let leq t1 t2 = - match t1, t2 with - | (H(x, _)), (H(y, _)) -> Elem.leq x y - | H _, E -> false - | E, H _ -> true - | E, E -> true - let eq t1 t2 = - match t1, t2 with - | (H(x, _)), (H(y, _)) -> Elem.eq x y - | H _, E -> false - | E, H _ -> false - | E, E -> true - let lt t1 t2 = - match t1, t2 with - | (H(x, _)), (H(y, _)) -> Elem.lt x y - | H _, E -> false - | E, H _ -> true - | E, E -> false - end - and PrimH - : HEAP with type Elem.t = BE.t - = MakeH(BE) - type heap = BE.t - let empty = BE.E - let isEmpty = function BE.E -> true | _ -> false - let rec merge x y = - match (x,y) with - (BE.E, _) -> y - | (_, BE.E) -> x - | (BE.H(e1,p1) as h1), (BE.H(e2,p2) as h2) -> - if Elem.leq e1 e2 - then BE.H(e1, PrimH.insert h2 p1) - else BE.H(e2, PrimH.insert h1 p2) - let insert x h = - merge (BE.H(x, PrimH.empty)) h - let findMin = function - BE.E -> raise Not_found - | BE.H(x, _) -> x - let deleteMin = function - BE.E -> raise Not_found - | BE.H(x, p) -> - if PrimH.isEmpty p then BE.E else begin - match PrimH.findMin p with - | (BE.H(y, p1)) -> - let p2 = PrimH.deleteMin p in - BE.H(y, PrimH.merge p1 p2) - | BE.E -> assert false - end - end -;; - -module LeftistHeap(Element: ORDERED): HEAP with module Elem = Element = - struct - module Elem = Element - type heap = E | T of int * Elem.t * heap * heap - let rank = function E -> 0 | T(r,_,_,_) -> r - let make x a b = - if rank a >= rank b - then T(rank b + 1, x, a, b) - else T(rank a + 1, x, b, a) - let empty = E - let isEmpty = function E -> true | _ -> false - let rec merge h1 h2 = - match (h1, h2) with - (_, E) -> h1 - | (E, _) -> h2 - | (T(_, x1, a1, b1), T(_, x2, a2, b2)) -> - if Elem.leq x1 x2 - then make x1 a1 (merge b1 h2) - else make x2 a2 (merge h1 b2) - let insert x h = merge (T(1, x, E, E)) h - let findMin = function - E -> raise Not_found - | T(_, x, _, _) -> x - let deleteMin = function - E -> raise Not_found - | T(_, x, a, b) -> merge a b - end -;; - -module Ints = - struct - type t = int - let eq = (=) - let lt = (<) - let leq = (<=) - end -;; - -module C = Bootstrap(LeftistHeap)(Ints);; - -let _ = - let h = List.fold_right C.insert [6;4;8;7;3;1] C.empty in - test 60 (C.findMin h) 1; - test 61 (C.findMin (C.deleteMin h)) 3; - test 62 (C.findMin (C.deleteMin (C.deleteMin h))) 4 -;; - -(* Classes *) - -module rec Class1 - : sig - class c : object method m : int -> int end - end - = struct - class c = - object - method m x = if x <= 0 then x else (new Class2.d)#m x - end - end -and Class2 - : sig - class d : object method m : int -> int end - end - = struct - class d = - object(self) - inherit Class1.c as super - method m (x:int) = super#m 0 - end - end -;; - -let _ = - test 70 ((new Class1.c)#m 7) 0 -;; - -let _ = - try - let module A = struct - module rec BadClass1 - : sig - class c : object method m : int end - end - = struct - class c = object method m = 123 end - end - and BadClass2 - : sig - val x: int - end - = struct - let x = (new BadClass1.c)#m - end - end in - test 71 true false - with Undefined_recursive_module _ -> - test 71 true true -;; - -(* Coercions *) - -module rec Coerce1 - : sig - val g: int -> int - val f: int -> int - end - = struct - module A = (Coerce1: sig val f: int -> int end) - let g x = x - let f x = if x <= 0 then 1 else A.f (x-1) * x - end -;; - -let _ = - test 80 (Coerce1.f 10) 3628800 -;; - -module CoerceF(S: sig end) = struct - let f1 () = 1 - let f2 () = 2 - let f3 () = 3 - let f4 () = 4 - let f5 () = 5 -end - -module rec Coerce2: sig val f1: unit -> int end = CoerceF(Coerce3) - and Coerce3: sig end = struct end -;; - -let _ = - test 81 (Coerce2.f1 ()) 1 -;; - -module Coerce4(A : sig val f : int -> int end) = struct - let x = 0 - let at a = A.f a -end - -module rec Coerce5 - : sig val blabla: int -> int val f: int -> int end - = struct let blabla x = 0 let f x = 5 end -and Coerce6 - : sig val at: int -> int end - = Coerce4(Coerce5) - -let _ = - test 82 (Coerce6.at 100) 5 -;; - -(* Miscellaneous bug reports *) - -module rec F - : sig type t = X of int | Y of int - val f: t -> bool - end - = struct - type t = X of int | Y of int - let f = function - | X _ -> false - | _ -> true - end;; - -let _ = - test 100 (F.f (F.X 1)) false; - test 101 (F.f (F.Y 2)) true - -(* PR#4316 *) -module G(S : sig val x : int Lazy.t end) = struct include S end - -module M1 = struct let x = lazy 3 end - -let _ = Lazy.force M1.x - -module rec M2 : sig val x : int Lazy.t end = G(M1) - -let _ = - test 102 (Lazy.force M2.x) 3 - -let _ = Gc.full_major() (* will shortcut forwarding in M1.x *) - -module rec M3 : sig val x : int Lazy.t end = G(M1) - -let _ = - test 103 (Lazy.force M3.x) 3 - - -(** Pure type-checking tests: see recmod/*.ml *) -type t = A of {x:int; mutable y:int};; -let f (A r) = r;; (* -> escape *) -let f (A r) = r.x;; (* ok *) -let f x = A {x; y = x};; (* ok *) -let f (A r) = A {r with y = r.x + 1};; (* ok *) -let f () = A {a = 1};; (* customized error message *) -let f () = A {x = 1; y = 3};; (* ok *) - -type _ t = A: {x : 'a; y : 'b} -> 'a t;; -let f (A {x; y}) = A {x; y = ()};; (* ok *) -let f (A ({x; y} as r)) = A {x = r.x; y = r.y};; (* ok *) - -module M = struct - type 'a t = - | A of {x : 'a} - | B: {u : 'b} -> unit t;; - - exception Foo of {x : int};; -end;; - -module N : sig - type 'b t = 'b M.t = - | A of {x : 'b} - | B: {u : 'bla} -> unit t - - exception Foo of {x : int} -end = struct - type 'b t = 'b M.t = - | A of {x : 'b} - | B: {u : 'z} -> unit t - - exception Foo = M.Foo -end;; - - -module type S = sig exception A of {x:int} end;; - -module F (X : sig val x : (module S) end) = struct - module A = (val X.x) -end;; (* -> this expression creates fresh types (not really!) *) - - -module type S = sig - exception A of {x : int} - exception A of {x : string} -end;; - -module M = struct - exception A of {x : int} - exception A of {x : string} -end;; - - -module M1 = struct - exception A of {x : int} -end;; - -module M = struct - include M1 - include M1 -end;; - - -module type S1 = sig - exception A of {x : int} -end;; - +(* Signature items *) module type S = sig - include S1 - include S1 -end;; - -module M = struct - exception A = M1.A -end;; - -module X1 = struct - type t = .. -end;; -module X2 = struct - type t = .. -end;; -module Z = struct - type X1.t += A of {x: int} - type X2.t += A of {x: int} -end;; - -(* PR#6716 *) - -type _ c = C : [`A] c -type t = T : {x:[<`A] c} -> t;; -let f (T { x = C }) = ();; -module M : sig - type 'a t - type u = u t and v = v t - val f : int -> u - val g : v -> bool -end = struct - type 'a t = 'a - type u = int and v = bool - let f x = x - let g x = x -end;; - -let h (x : int) : bool = M.g (M.f x);; -type _ t = C : ((('a -> 'o) -> 'o) -> ('b -> 'o) -> 'o) t -let f : type a o. ((a -> o) -> o) t -> (a -> o) -> o = - fun C k -> k (fun x -> x);; -module type T = sig type 'a t end -module Fix (T : T) = struct type r = ('r T.t as 'r) end - type _ t = - X of string - | Y : bytes t - -let y : string t = Y -let f : string A.t -> unit = function - A.X s -> print_endline s - -let () = f A.y -module rec A : sig - type t -end = struct - type t = { a : unit; b : unit } - let _ = { a = () } -end -;; -type t = [`A | `B];; -type 'a u = t;; -let a : [< int u] = `A;; - -type 'a s = 'a;; -let b : [< t s] = `B;; -module Core = struct - module Int = struct - module T = struct - type t = int - let compare = compare - let (+) x y = x + y - end - include T - module Map = Map.Make(T) - end - - module Std = struct - module Int = Int - end -end -;; - -open Core.Std -;; - -let x = Int.Map.empty ;; -let y = x + x ;; - -(* Avoid ambiguity *) - -module M = struct type t = A type u = C end -module N = struct type t = B end -open M open N;; -A;; -B;; -C;; - -include M open M;; -C;; - -module L = struct type v = V end -open L;; -V;; -module L = struct type v = V end -open L;; -V;; - - -type t1 = A;; -module M1 = struct type u = v and v = t1 end;; -module N1 = struct type u = v and v = M1.v end;; -type t1 = B;; -module N2 = struct type u = v and v = M1.v end;; - - -(* PR#6566 *) -module type PR6566 = sig type t = string end;; -module PR6566 = struct type t = int end;; -module PR6566' : PR6566 = PR6566;; - -module A = struct module B = struct type t = T end end;; -module M2 = struct type u = A.B.t type foo = int type v = A.B.t end;; -(* Adapted from: An Expressive Language of Signatures - by Norman Ramsey, Kathleen Fisher and Paul Govereau *) - -module type VALUE = sig - type value (* a Lua value *) - type state (* the state of a Lua interpreter *) - type usert (* a user-defined value *) -end;; - -module type CORE0 = sig - module V : VALUE - val setglobal : V.state -> string -> V.value -> unit - (* five more functions common to core and evaluator *) -end;; - -module type CORE = sig - include CORE0 - val apply : V.value -> V.state -> V.value list -> V.value - (* apply function f in state s to list of args *) -end;; - -module type AST = sig - module Value : VALUE - type chunk - type program - val get_value : chunk -> Value.value -end;; - -module type EVALUATOR = sig - module Value : VALUE - module Ast : (AST with module Value := Value) - type state = Value.state - type value = Value.value - exception Error of string - val compile : Ast.program -> string - include CORE0 with module V := Value -end;; - -module type PARSER = sig - type chunk - val parse : string -> chunk -end;; - -module type INTERP = sig - include EVALUATOR - module Parser : PARSER with type chunk = Ast.chunk - val dostring : state -> string -> value list - val mk : unit -> state -end;; - -module type USERTYPE = sig - type t - val eq : t -> t -> bool - val to_string : t -> string -end;; - -module type TYPEVIEW = sig - type combined - type t - val map : (combined -> t) * (t -> combined) -end;; - -module type COMBINED_COMMON = sig - module T : sig type t end - module TV1 : TYPEVIEW with type combined := T.t - module TV2 : TYPEVIEW with type combined := T.t -end;; - -module type COMBINED_TYPE = sig - module T : USERTYPE - include COMBINED_COMMON with module T := T -end;; - -module type BARECODE = sig - type state - val init : state -> unit -end;; - -module USERCODE(X : TYPEVIEW) = struct - module type F = - functor (C : CORE with type V.usert = X.combined) -> - BARECODE with type state := C.V.state -end;; - -module Weapon = struct type t end;; - -module type WEAPON_LIB = sig - type t = Weapon.t - module T : USERTYPE with type t = t - module Make : - functor (TV : TYPEVIEW with type t = t) -> USERCODE(TV).F -end;; - -module type X = functor (X: CORE) -> BARECODE;; -module type X = functor (_: CORE) -> BARECODE;; -module M = struct - type t = int * (< m : 'a > as 'a) -end;; - -module type S = - sig module M : sig type t end end with module M = M -;; -module type Printable = sig - type t - val print : Format.formatter -> t -> unit -end;; -module type Comparable = sig - type t - val compare : t -> t -> int -end;; -module type PrintableComparable = sig - include Printable - include Comparable with type t = t -end;; (* Fails *) -module type PrintableComparable = sig - type t - include Printable with type t := t - include Comparable with type t := t -end;; -module type PrintableComparable = sig - include Printable - include Comparable with type t := t -end;; -module type ComparableInt = Comparable with type t := int;; -module type S = sig type t val f : t -> t end;; -module type S' = S with type t := int;; - -module type S = sig type 'a t val map : ('a -> 'b) -> 'a t -> 'b t end;; -module type S1 = S with type 'a t := 'a list;; -module type S2 = sig - type 'a dict = (string * 'a) list - include S with type 'a t := 'a dict -end;; - - -module type S = - sig module T : sig type exp type arg end val f : T.exp -> T.arg end;; -module M = struct type exp = string type arg = int end;; -module type S' = S with module T := M;; - - -module type S = sig type 'a t end with type 'a t := unit;; (* Fails *) -let property (type t) () = - let module M = struct exception E of t end in - (fun x -> M.E x), (function M.E x -> Some x | _ -> None) -;; - -let () = - let (int_inj, int_proj) = property () in - let (string_inj, string_proj) = property () in - - let i = int_inj 3 in - let s = string_inj "abc" in - - Printf.printf "%B\n%!" (int_proj i = None); - Printf.printf "%B\n%!" (int_proj s = None); - Printf.printf "%B\n%!" (string_proj i = None); - Printf.printf "%B\n%!" (string_proj s = None) -;; - -let sort_uniq (type s) cmp l = - let module S = Set.Make(struct type t = s let compare = cmp end) in - S.elements (List.fold_right S.add l S.empty) -;; - -let () = - print_endline (String.concat "," (sort_uniq compare [ "abc"; "xyz"; "abc" ])) -;; - -let f x (type a) (y : a) = (x = y);; (* Fails *) -class ['a] c = object (self) - method m : 'a -> 'a = fun x -> x - method n : 'a -> 'a = fun (type g) (x:g) -> self#m x -end;; (* Fails *) - -external a : (int [@untagged]) -> unit = "a" "a_nat" -external b : (int32 [@unboxed]) -> unit = "b" "b_nat" -external c : (int64 [@unboxed]) -> unit = "c" "c_nat" -external d : (nativeint [@unboxed]) -> unit = "d" "d_nat" -external e : (float [@unboxed]) -> unit = "e" "e_nat" - -type t = private int - -external f : (t [@untagged]) -> unit = "f" "f_nat" - -module M : sig - external a : int -> (int [@untagged]) = "a" "a_nat" - external b : (int [@untagged]) -> int = "b" "b_nat" -end = struct - external a : int -> (int [@untagged]) = "a" "a_nat" - external b : (int [@untagged]) -> int = "b" "b_nat" -end;; - -module Global_attributes = struct - [@@@ocaml.warning "-3"] - - external a : float -> float = "a" "noalloc" "a_nat" "float" - external b : float -> float = "b" "noalloc" "b_nat" - external c : float -> float = "c" "c_nat" "float" - external d : float -> float = "d" "noalloc" - external e : float -> float = "e" - - (* Should output a warning: no native implementation provided *) - external f : (int32 [@unboxed]) -> (int32 [@unboxed]) = "f" "noalloc" - external g : int32 -> int32 = "g" "g_nat" [@@unboxed] [@@noalloc] - - external h : (int [@untagged]) -> (int [@untagged]) = "h" "h_nat" "noalloc" - external i : int -> int = "i" "i_nat" [@@untagged] [@@noalloc] -end;; - -module Old_style_warning = struct - [@@@ocaml.warning "+3"] - external a : float -> float = "a" "noalloc" "a_nat" "float" - external b : float -> float = "b" "noalloc" "b_nat" - external c : float -> float = "c" "c_nat" "float" - external d : float -> float = "d" "noalloc" - external e : float -> float = "c" "float" -end - -(* Bad: attributes not reported in the interface *) - -module Bad1 : sig - external f : int -> int = "f" "f_nat" -end = struct - external f : int -> (int [@untagged]) = "f" "f_nat" -end;; - -module Bad2 : sig - external f : int -> int = "a" "a_nat" -end = struct - external f : (int [@untagged]) -> int = "f" "f_nat" -end;; - -module Bad3 : sig - external f : float -> float = "f" "f_nat" -end = struct - external f : float -> (float [@unboxed]) = "f" "f_nat" -end;; - -module Bad4 : sig - external f : float -> float = "a" "a_nat" -end = struct - external f : (float [@unboxed]) -> float = "f" "f_nat" -end;; - -(* Bad: attributes in the interface but not in the implementation *) - -module Bad5 : sig - external f : int -> (int [@untagged]) = "f" "f_nat" -end = struct - external f : int -> int = "f" "f_nat" -end;; - -module Bad6 : sig - external f : (int [@untagged]) -> int = "f" "f_nat" -end = struct - external f : int -> int = "a" "a_nat" -end;; - -module Bad7 : sig - external f : float -> (float [@unboxed]) = "f" "f_nat" -end = struct - external f : float -> float = "f" "f_nat" -end;; - -module Bad8 : sig - external f : (float [@unboxed]) -> float = "f" "f_nat" -end = struct - external f : float -> float = "a" "a_nat" -end;; - -(* Bad: unboxed or untagged with the wrong type *) - -external g : (float [@untagged]) -> float = "g" "g_nat";; -external h : (int [@unboxed]) -> float = "h" "h_nat";; - -(* Bad: unboxing the function type *) -external i : int -> float [@unboxed] = "i" "i_nat";; - -(* Bad: unboxing a "deep" sub-type. *) -external j : int -> (float [@unboxed]) * float = "j" "j_nat";; - -(* This should be rejected, but it is quite complicated to do - in the current state of things *) - -external k : int -> (float [@unboxd]) = "k" "k_nat";; - -(* Bad: old style annotations + new style attributes *) - -external l : float -> float = "l" "l_nat" "float" [@@unboxed];; -external m : (float [@unboxed]) -> float = "m" "m_nat" "float";; -external n : float -> float = "n" "noalloc" [@@noalloc];; - -(* Warnings: unboxed / untagged without any native implementation *) -external o : (float[@unboxed]) -> float = "o";; -external p : float -> (float[@unboxed]) = "p";; -external q : (int[@untagged]) -> float = "q";; -external r : int -> (int[@untagged]) = "r";; -external s : int -> int = "s" [@@untagged];; -external t : float -> float = "t" [@@unboxed];; -let _ = ignore (+);; -let _ = raise Exit 3;; -(* comment 9644 of PR#6000 *) - -fun b -> if b then format_of_string "x" else "y";; -fun b -> if b then "x" else format_of_string "y";; -fun b : (_,_,_) format -> if b then "x" else "y";; - -(* PR#7135 *) - -module PR7135 = struct - module M : sig type t = private int end = struct type t = int end - include M - - let lift2 (f : int -> int -> int) (x : t) (y : t) = - f (x :> int) (y :> int) -end;; - -(* exemple of non-ground coercion *) - -module Test1 = struct - type t = private int - let f x = let y = if true then x else (x:t) in (y :> int) -end;; -(* Warn about all relevant cases when possible *) -let f = function - None, None -> 1 - | Some _, Some _ -> 2;; - -(* Exhaustiveness check is very slow *) -type _ t = - A : int t | B : bool t | C : char t | D : float t -type (_,_,_,_) u = U : (int, int, int, int) u -type v = E | F | G -;; - -let f : type a b c d e f g. - a t * b t * c t * d t * e t * f t * g t * v - * (a,b,c,d) u * (e,f,g,g) u -> int = - function A, A, A, A, A, A, A, _, U, U -> 1 - | _, _, _, _, _, _, _, G, _, _ -> 1 - (*| _ -> _ *) -;; - -(* Unused cases *) -let f (x : int t) = match x with A -> 1 | _ -> 2;; (* warn *) -let f (x : unit t option) = match x with None -> 1 | _ -> 2 ;; (* warn? *) -let f (x : unit t option) = match x with None -> 1 | Some _ -> 2 ;; (* warn *) -let f (x : int t option) = match x with None -> 1 | _ -> 2;; -let f (x : int t option) = match x with None -> 1;; (* warn *) - -(* Example with record, type, single case *) - -type 'a box = Box of 'a -type 'a pair = {left: 'a; right: 'a};; - -let f : (int t box pair * bool) option -> unit = function None -> ();; -let f : (string t box pair * bool) option -> unit = function None -> ();; - - -(* Examples from ML2015 paper *) - -type _ t = - | Int : int t - | Bool : bool t -;; - -let f : type a. a t -> a = function - | Int -> 1 - | Bool -> true -;; -let g : int t -> int = function - | Int -> 1 -;; -let h : type a. a t -> a t -> bool = - fun x y -> match x, y with - | Int, Int -> true - | Bool, Bool -> true -;; -type (_, _) cmp = - | Eq : ('a, 'a) cmp - | Any: ('a, 'b) cmp -module A : sig type a type b val eq : (a, b) cmp end - = struct type a type b = a let eq = Eq end -;; -let f : (A.a, A.b) cmp -> unit = function Any -> () -;; -let deep : char t option -> char = - function None -> 'c' -;; -type zero = Zero -type _ succ = Succ -;; -type (_,_,_) plus = - | Plus0 : (zero, 'a, 'a) plus - | PlusS : ('a, 'b, 'c) plus -> - ('a succ, 'b, 'c succ) plus -;; -let trivial : (zero succ, zero, zero) plus option -> bool = - function None -> false -;; -let easy : (zero, zero succ, zero) plus option -> bool = - function None -> false -;; -let harder : (zero succ, zero succ, zero succ) plus option -> bool = - function None -> false -;; -let harder : (zero succ, zero succ, zero succ) plus option -> bool = - function None -> false | Some (PlusS _) -> . -;; -let inv_zero : type a b c d. (a,b,c) plus -> (c,d,zero) plus -> bool = - fun p1 p2 -> - match p1, p2 with - | Plus0, Plus0 -> true -;; - - -(* Empty match *) - -type _ t = Int : int t;; -let f (x : bool t) = match x with _ -> . ;; (* ok *) - - -(* trefis in PR#6437 *) - -let f () = match None with _ -> .;; (* error *) -let g () = match None with _ -> () | exception _ -> .;; (* error *) -let h () = match None with _ -> . | exception _ -> .;; (* error *) -let f x = match x with _ -> () | None -> .;; (* do not warn *) - -(* #7059, all clauses guarded *) - -let f x y = match 1 with 1 when x = y -> 1;; -open CamlinternalOO;; -type _ choice = Left : label choice | Right : tag choice;; -let f : label choice -> bool = function Left -> true;; (* warn *) -exception A;; -type a = A;; - -A;; -raise A;; -fun (A : a) -> ();; -function Not_found -> 1 | A -> 2 | _ -> 3;; -try raise A with A -> 2;; -module TypEq = struct - type (_, _) t = Eq : ('a, 'a) t -end - -module type T = sig - type _ is_t = Is : ('a, 'b) TypEq.t -> 'a is_t - val is_t : unit -> unit is_t option -end - -module Make (M : T) = - struct - let _ = - match M.is_t () with - | None -> 0 - | Some _ -> 0 - let f () = - match M.is_t () with None -> 0 -end;; - -module Make2 (M : T) = struct - type t = T of unit M.is_t - let g : t -> int = function _ -> . -end;; -type t = A : t;; - -module X1 : sig end = struct - let _f ~x (* x unused argument *) = function - | A -> let x = () in x -end;; - -module X2 : sig end = struct - let x = 42 (* unused value *) - let _f = function - | A -> let x = () in x -end;; - -module X3 : sig end = struct - module O = struct let x = 42 (* unused *) end - open O (* unused open *) - - let _f = function - | A -> let x = () in x -end;; -(* Use type information *) -module M1 = struct - type t = {x: int; y: int} - type u = {x: bool; y: bool} -end;; - -module OK = struct - open M1 - let f1 (r:t) = r.x (* ok *) - let f2 r = ignore (r:t); r.x (* non principal *) - - let f3 (r: t) = - match r with {x; y} -> y + y (* ok *) -end;; - -module F1 = struct - open M1 - let f r = match r with {x; y} -> y + y -end;; (* fails *) - -module F2 = struct - open M1 - let f r = - ignore (r: t); - match r with - {x; y} -> y + y -end;; (* fails for -principal *) - -(* Use type information with modules*) -module M = struct - type t = {x:int} - type u = {x:bool} -end;; -let f (r:M.t) = r.M.x;; (* ok *) -let f (r:M.t) = r.x;; (* warning *) -let f ({x}:M.t) = x;; (* warning *) - -module M = struct - type t = {x: int; y: int} -end;; -module N = struct - type u = {x: bool; y: bool} -end;; -module OK = struct - open M - open N - let f (r:M.t) = r.x -end;; - -module M = struct - type t = {x:int} - module N = struct type s = t = {x:int} end - type u = {x:bool} -end;; -module OK = struct - open M.N - let f (r:M.t) = r.x -end;; - -(* Use field information *) -module M = struct - type u = {x:bool;y:int;z:char} - type t = {x:int;y:bool} -end;; -module OK = struct - open M - let f {x;z} = x,z -end;; (* ok *) -module F3 = struct - open M - let r = {x=true;z='z'} -end;; (* fail for missing label *) - -module OK = struct - type u = {x:int;y:bool} - type t = {x:bool;y:int;z:char} - let r = {x=3; y=true} -end;; (* ok *) - -(* Corner cases *) - -module F4 = struct - type foo = {x:int; y:int} - type bar = {x:int} - let b : bar = {x=3; y=4} -end;; (* fail but don't warn *) - -module M = struct type foo = {x:int;y:int} end;; -module N = struct type bar = {x:int;y:int} end;; -let r = { M.x = 3; N.y = 4; };; (* error: different definitions *) - -module MN = struct include M include N end -module NM = struct include N include M end;; -let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *) - -(* Lpw25 *) - -module M = struct - type foo = { x: int; y: int } - type bar = { x:int; y: int; z: int} -end;; -module F5 = struct - open M - let f r = ignore (r: foo); {r with x = 2; z = 3} -end;; -module M = struct - include M - type other = { a: int; b: int } -end;; -module F6 = struct - open M - let f r = ignore (r: foo); { r with x = 3; a = 4 } -end;; -module F7 = struct - open M - let r = {x=1; y=2} - let r: other = {x=1; y=2} -end;; - -module A = struct type t = {x: int} end -module B = struct type t = {x: int} end;; -let f (r : B.t) = r.A.x;; (* fail *) - -(* Spellchecking *) - -module F8 = struct - type t = {x:int; yyy:int} - let a : t = {x=1;yyz=2} -end;; - -(* PR#6004 *) - -type t = A -type s = A - -class f (_ : t) = object end;; -class g = f A;; (* ok *) - -class f (_ : 'a) (_ : 'a) = object end;; -class g = f (A : t) A;; (* warn with -principal *) - - -(* PR#5980 *) - -module Shadow1 = struct - type t = {x: int} - module M = struct - type s = {x: string} - end - open M (* this open is unused, it isn't reported as shadowing 'x' *) - let y : t = {x = 0} -end;; -module Shadow2 = struct - type t = {x: int} - module M = struct - type s = {x: string} - end - open M (* this open shadows label 'x' *) - let y = {x = ""} -end;; - -(* PR#6235 *) - -module P6235 = struct - type t = { loc : string; } - type v = { loc : string; x : int; } - type u = [ `Key of t ] - let f (u : u) = match u with `Key {loc} -> loc -end;; - -(* Remove interaction between branches *) - -module P6235' = struct - type t = { loc : string; } - type v = { loc : string; x : int; } - type u = [ `Key of t ] - let f = function - | (_ : u) when false -> "" - |`Key {loc} -> loc -end;; -module Unused : sig -end = struct - type unused = int -end -;; - -module Unused_nonrec : sig -end = struct - type nonrec used = int - type nonrec unused = used -end -;; - -module Unused_rec : sig -end = struct - type unused = A of unused -end -;; - -module Unused_exception : sig -end = struct - exception Nobody_uses_me -end -;; - -module Unused_extension_constructor : sig - type t = .. -end = struct - type t = .. - type t += Nobody_uses_me -end -;; - -module Unused_exception_outside_patterns : sig - val falsity : exn -> bool -end = struct - exception Nobody_constructs_me - let falsity = function - | Nobody_constructs_me -> true - | _ -> false -end -;; - -module Unused_extension_outside_patterns : sig - type t = .. - val falsity : t -> bool -end = struct - type t = .. - type t += Nobody_constructs_me - let falsity = function - | Nobody_constructs_me -> true - | _ -> false -end -;; - -module Unused_private_exception : sig - type exn += private Private_exn -end = struct - exception Private_exn -end -;; - -module Unused_private_extension : sig - type t = .. - type t += private Private_ext -end = struct - type t = .. - type t += Private_ext -end -;; - -for i = 10 downto 0 do () done - -type t = < foo: int [@foo] > - -let _ = [%foo: < foo : t > ] - -type foo += private A of int - -let f : 'a 'b 'c. < .. > = assert false - -let () = - let module M = (functor (T : sig end) -> struct end)(struct end) in () - -class c = object inherit ((fun () -> object end [@wee]: object end) ()) end - - -let f = function x[@wee] -> () -let f = function - | '1'..'9' | '1' .. '8'-> () - | 'a'..'z' -> () - -let f = function - | [| x1; x2 |] -> () - | [| |] -> () - | [|x|][@foo] -> () - | _ -> () - -let g = function - | {l=x} -> () - | {l1=x; l2=y}[@foo] -> () - | {l1=x; l2=y; _} -> () - -let h = fun ?l:(p=1) ?y:u ?x:(x=3) -> 2 - -let _ = function - | a, s, ba1, ba2, ba3, bg -> begin - ignore (Array.get x 1 + Array.get [| |] 0 + - Array.get [| 1 |] 1 + Array.get [|1; 2|] 2); - ignore ([String.get s 1; String.get "" 2; String.get "123" 3]); - ignore (ba1.{0} + ba2.{1, 2} + ba3.{3, 4, 5}) - ignore (bg.{1, 2, 3, 4}) - end - | b, s, ba1, ba2, ba3, bg -> begin - y.(0) <- 1; s.[1] <- 'c'; - ba1.{1} <- 2; ba2.{1, 2} <- 3; ba3.{1, 2, 3} <- 4; - bg.{1, 2, 3, 4, 5} <- 0 - end - -let f (type t) () = - let exception F of t in (); - let exception G of t in (); - let exception E of t in - (fun x -> E x), (function E _ -> print_endline "OK" | _ -> print_endline "KO") - -let inj1, proj1 = f () -let inj2, proj2 = f () - -let () = proj1 (inj1 42) -let () = proj1 (inj2 42) - -let _ = ~-1 - -class id = [%exp] -(* checkpoint *) - -(* Subtyping is "syntactic" *) -let _ = fun (x : < x : int >) y z -> (y :> 'a), (x :> 'a), (z :> 'a);; -(* - : (< x : int > as 'a) -> 'a -> 'a * 'a = <fun> *) - -class ['a] c () = object - method f = (new c (): int c) -end and ['a] d () = object - inherit ['a] c () -end;; - -(* PR#7329 Pattern open *) -let _ = - let module M = struct type t = { x : int } end in - let f M.(x) = () in - let g M.{x} = () in - let h = function M.[] | M.[a] | M.(a::q) -> () in - let i = function M.[||] | M.[|x|] -> true | _ -> false in - () - -class ['a] c () = object - constraint 'a = < .. > -> unit - method m = (fun x -> () : 'a) -end - -let f: type a'.a' = assert false -let foo : type a' b'. a' -> b' = fun a -> assert false -let foo : type t' . t' = fun (type t') -> (assert false : t') -let foo : 't . 't = fun (type t) -> (assert false : t) -let foo : type a' b' c' t. a' -> b' -> c' -> t = fun a b c -> assert false - -let f x = - x.contents <- (print_string "coucou" ; x.contents) - -let ( ~$ ) x = Some x -let g x = - ~$ (x.contents) - -let ( ~$ ) x y = (x, y) -let g x y = - ~$ (x.contents) (y.contents) - - - -(* PR#7506: attributes on list tail *) - -let tail1 = ([1; 2])[@hello] -let tail2 = 0::(([1; 2])[@hello]) -let tail3 = 0::(([])[@hello]) - -let f ~l:(l[@foo]) = l;; -let test x y = ((+)[@foo]) x y;; -let test x = ((~-)[@foo]) x;; -let test contents = { contents = contents[@foo] };; -class type t = object(_[@foo]) end;; -class t = object(_[@foo]) end;; -let test f x = f ~x:(x[@foo]);; -let f = function ((`A|`B)[@bar]) | `C -> ();; -let f = function _::(_::_ [@foo]) -> () | _ -> ();; -function {contents=contents[@foo]} -> ();; -fun contents -> {contents=contents[@foo]};; -((); (((); ())[@foo]));; - -(* https://github.com/LexiFi/gen_js_api/issues/61 *) - -let () = foo##.bar := ();; - -(* "let open" in classes and class types *) - -class c = - let open M in - object - method f : t = x - end -;; -class type ct = - let open M in - object - method f : t - end -;; - -(* M.(::) notation *) -module Exotic_list = struct - module Inner = struct - type ('a,'b) t = [] | (::) of 'a * 'b * ('a,'b) t - end - - let Inner.(::)(x,y, Inner.[]) = Inner.(::)(1,"one",Inner.[]) -end + class%foo x : t [@@foo] + class type%foo x = x [@@foo] -(** Extended index operators *) -module Indexop = struct - module Def = struct - let ( .%[] ) = Hashtbl.find - let ( .%[] <- ) = Hashtbl.add - let ( .%() ) = Hashtbl.find - let ( .%() <- ) = Hashtbl.add - let ( .%{} ) = Hashtbl.find - let ( .%{} <- ) = Hashtbl.add - end - ;; - let h = Hashtbl.create 17 in - h.Def.%["one"] <- 1; - h.Def.%("two") <- 2; - h.Def.%{"three"} <- 3 - let x,y,z = Def.(h.%["one"], h.%("two"), h.%{"three"}) end -type t = | include struct let%test_module "as" = @@ -7572,11 +215,6 @@ let foo () = then x else y -let xxxxxx = - let%map (* _____________________________ - __________ *)() = yyyyyyyy in - { zzzzzzzzzzzzz } - let _ = match x with | _ diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp deleted file mode 100644 index a126c2d2f6..0000000000 --- a/test/passing/tests/js_source.ml.ocp +++ /dev/null @@ -1,10548 +0,0 @@ -[@@@foo] - -let (x [@foo]) : (unit[@foo]) = () [@foo] [@@foo] - -type t = Foo of (t[@foo]) [@foo] [@@foo] - -[@@@foo] - -module M = struct - type t = { l : (t[@foo]) [@foo] } [@@foo] [@@foo] - - [@@@foo] -end [@foo] -[@@foo] - -module type S = sig - include ((module type of M [@foo]) [@foo] with type t := M.t [@foo]) [@@foo] - - [@@@foo] -end [@foo] -[@@foo] - -[@@@foo] - -type 'a with_default = - ?size:int (** default [42] *) -> ?resizable:bool (** default [true] *) -> 'a - -type obj = < meth1 : int -> int (** method 1 *) ; meth2 : unit -> float (** method 2 *) > - -type var = - [ `Foo (** foo *) - | `Bar of int * string (** bar *) - ] - -[%%foo - let x = 1 in - x] - -let [%foo 2 + 1] : [%foo bar.baz] = [%foo "foo"] - -[%%foo module M = [%bar]] - -let [%foo let () = ()] : [%foo type t = t] = [%foo class c = object end] - -[%%foo: 'a list] - -let [%foo: [ `Foo ]] : [%foo: t -> t] = [%foo: < foo : t > ] - -[%%foo? _] -[%%foo? Some y when y > 0] - -let [%foo? Bar x | Baz x] : [%foo? #bar] = [%foo? { x }] - -[%%foo: module M : [%baz]] - -let [%foo: include S with type t = t] -: [%foo: - val x : t - val y : t] - = - [%foo: type t = t] -;; - -let int_with_custom_modifier = 1234567890_1234567890_1234567890_1234567890_1234567890z -let float_with_custom_modifier = 1234567890_1234567890_1234567890_1234567890_1234567890.z -let int32 = 1234l -let int64 = 1234L -let nativeint = 1234n -let hex_without_modifier = 0x32f -let hex_with_modifier = 0x32g -let float_without_modifer = 1.2e3 -let float_with_modifer = 1.2g -let%foo x = 42 - -let%foo _ = () -and _ = () - -let%foo _ = () - -(* Expressions *) -let () = - let%foo[@foo] x = 3 - and[@foo] y = 4 in - [%foo - (let module M = M in - ()) - [@foo]]; - [%foo - (let open M in - ()) [@foo]]; - [%foo fun [@foo] x -> ()]; - [%foo - function[@foo] - | x -> ()]; - [%foo - try[@foo] () with - | _ -> ()]; - if%foo [@foo] () then () else (); - [%foo - while () do - () - done - [@foo]]; - [%foo - for x = () to () do - () - done - [@foo]]; - [%foo assert true [@foo]]; - [%foo lazy x [@foo]]; - [%foo object end [@foo]]; - [%foo - begin [@foo] - 3 - end]; - [%foo new x [@foo]]; - [%foo - match[@foo] () with - | [%foo? - (* Pattern expressions *) - ((lazy x) [@foo])] -> () - | [%foo? ((exception x) [@foo])] -> ()] -;; - -(* Class expressions *) -class x = - fun [@foo] x -> - let[@foo] x = 3 in - object - inherit x [@@foo] - val x = 3 [@@foo] - val virtual x : t [@@foo] - val! mutable x = 3 [@@foo] - method x = 3 [@@foo] - method virtual x : t [@@foo] - method! private x = 3 [@@foo] - initializer x [@@foo] - end - [@foo] - -(* Class type expressions *) -class type t = object - inherit t [@@foo] - val x : t [@@foo] - val mutable x : t [@@foo] - method x : t [@@foo] - method private x : t [@@foo] - constraint t = t' [@@foo] - [@@@abc] - [%%id] - [@@@aaa] -end[@foo] - -(* Type expressions *) -type t = [%foo: ((module M)[@foo])] - -(* Module expressions *) -module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo])) - -(* Module type expression *) -module type S = functor [@foo] (M : S) -> (_ : (module type of M) [@foo]) -> sig end - [@foo] - -module type S = (_ : S) (_ : S) -> S -module type S = (_ : (_ : S) -> S) -> S -module type S = functor (M : S) -> (_ : S) -> S -module type S = (_ : functor (M : S) -> S) -> S -module type S = (_ : functor [@foo] (_ : S) -> S) -> S -module type S = (_ : functor [@foo] (M : S) -> S) -> S - -module type S = sig - module rec A : (S with type t = t) - and B : (S with type t = t) -end - -(* Structure items *) -let%foo[@foo] x = 4 -and[@foo] y = x - -type%foo[@foo] t = int -and[@foo] t = int - -type%foo [@foo] t += T - -class%foo [@foo] x = x - -class type%foo [@foo] x = x - -external%foo [@foo] x : _ = "" - -exception%foo [@foo] X - -module%foo [@foo] M = M - -module%foo [@foo] rec M : S = M -and [@foo] M : S = M - -module type%foo [@foo] S = S - -include%foo [@foo] M -open%foo [@foo] M - -(* Signature items *) -module type S = sig - val%foo [@foo] x : t - external%foo [@foo] x : t = "" - - type%foo[@foo] t = int - and[@foo] t' = int - - type%foo [@foo] t += T - - exception%foo [@foo] X - - module%foo [@foo] M : S - - module%foo [@foo] rec M : S - and [@foo] M : S - - module%foo [@foo] M = M - - module type%foo [@foo] S = S - - include%foo [@foo] M - open%foo [@foo] M - - class%foo [@foo] x : t - - class type%foo [@foo] x = x - - class%foo x : t [@@foo] - - class type%foo x = x [@@foo] -end - -type t = .. -type t += A;; - -[%extension_constructor A];; -([%extension_constructor A] : extension_constructor) - -module M = struct - type extension_constructor = int -end - -open M;; - -([%extension_constructor A] : extension_constructor) - -(* By using two types we can have a recursive constraint *) -type 'a class_name = .. constraint 'a = < cast : 'a. 'a name -> 'a ; .. > -and 'a name = Class : 'a class_name -> (< cast : 'a. 'a name -> 'a ; .. > as 'a) name - -exception Bad_cast - -class type castable = object - method cast : 'a. 'a name -> 'a -end - -(* Lets create a castable class with a name*) - -class type foo_t = object - inherit castable - method foo : string -end - -type 'a class_name += Foo : foo_t class_name - -class foo : foo_t = - object (self) - method cast : type a. a name -> a = - function - | Class Foo -> (self :> foo_t) - | _ -> (raise Bad_cast : a) - - method foo = "foo" - end - -(* Now we can create a subclass of foo *) - -class type bar_t = object - inherit foo - method bar : string -end - -type 'a class_name += Bar : bar_t class_name - -class bar : bar_t = - object (self) - inherit foo as super - - method cast : type a. a name -> a = - function - | Class Bar -> (self :> bar_t) - | other -> super#cast other - - method bar = "bar" - [@@@id] - [%%id] - end - -(* Now lets create a mutable list of castable objects *) - -let clist : castable list ref = ref [] -let push_castable (c : #castable) = clist := (c :> castable) :: !clist - -let pop_castable () = - match !clist with - | c :: rest -> - clist := rest; - c - | [] -> raise Not_found -;; - -(* We can add foos and bars to this list, and retrive them *) - -push_castable (new foo);; -push_castable (new bar);; -push_castable (new foo) - -let c1 : castable = pop_castable () -let c2 : castable = pop_castable () -let c3 : castable = pop_castable () - -(* We can also downcast these values to foos and bars *) - -let f1 : foo = c1#cast (Class Foo) - -(* Ok *) -let f2 : foo = c2#cast (Class Foo) - -(* Ok *) -let f3 : foo = c3#cast (Class Foo) - -(* Ok *) - -let b1 : bar = c1#cast (Class Bar) - -(* Exception Bad_cast *) -let b2 : bar = c2#cast (Class Bar) - -(* Ok *) -let b3 : bar = c3#cast (Class Bar) - -(* Exception Bad_cast *) - -type foo = .. -type foo += A | B of int - -let is_a x = - match x with - | A -> true - | _ -> false -;; - -(* The type must be open to create extension *) - -type foo -type foo += A of int (* Error type is not open *) - -(* The type parameters must match *) - -type 'a foo = .. -type ('a, 'b) foo += A of int (* Error: type parameter mismatch *) - -(* In a signature the type does not have to be open *) - -module type S = sig - type foo - type foo += A of float -end - -(* But it must still be extensible *) - -module type S = sig - type foo = A of int - type foo += B of float (* Error foo does not have an extensible type *) -end - -(* Signatures can change the grouping of extensions *) - -type foo = .. - -module M = struct - type foo += A of int | B of string - type foo += C of int | D of float -end - -module type S = sig - type foo += B of string | C of int - type foo += D of float - type foo += A of int -end - -module M_S : S = M - -(* Extensions can be GADTs *) - -type 'a foo = .. -type _ foo += A : int -> int foo | B : int foo - -let get_num : type a. a foo -> a -> a option = - fun f i1 -> - match f with - | A i2 -> Some (i1 + i2) - | _ -> None -;; - -(* Extensions must obey constraints *) - -type 'a foo = .. constraint 'a = [> `Var ] -type 'a foo += A of 'a - -let a = A 9 (* ERROR: Constraints not met *) - -type 'a foo += B : int foo (* ERROR: Constraints not met *) - -(* Signatures can make an extension private *) - -type foo = .. - -module M = struct - type foo += A of int -end - -let a1 = M.A 10 - -module type S = sig - type foo += private A of int -end - -module M_S : S = M - -let is_s x = - match x with - | M_S.A _ -> true - | _ -> false -;; - -let a2 = M_S.A 20 (* ERROR: Cannot create a value using a private constructor *) - -(* Extensions can be rebound *) - -type foo = .. - -module M = struct - type foo += A1 of int -end - -type foo += A2 = M.A1 -type bar = .. -type bar += A3 = M.A1 (* Error: rebind wrong type *) - -module M = struct - type foo += private B1 of int -end - -type foo += private B2 = M.B1 -type foo += B3 = M.B1 (* Error: rebind private extension *) -type foo += C = Unknown (* Error: unbound extension *) - -(* Extensions can be rebound even if type is closed *) - -module M : sig - type foo - type foo += A1 of int -end = struct - type foo = .. - type foo += A1 of int -end - -type M.foo += A2 = M.A1 - -(* Rebinding handles abbreviations *) - -type 'a foo = .. -type 'a foo1 = 'a foo = .. -type 'a foo2 = 'a foo = .. -type 'a foo1 += A of int | B of 'a | C : int foo1 -type 'a foo2 += D = A | E = B | F = C - -(* Extensions must obey variances *) - -type +'a foo = .. -type 'a foo += A of (int -> 'a) -type 'a foo += B of ('a -> int) -(* ERROR: Parameter variances are not satisfied *) - -type _ foo += C : ('a -> int) -> 'a foo -(* ERROR: Parameter variances are not satisfied *) - -type 'a bar = .. -type +'a bar += D of (int -> 'a) (* ERROR: type variances do not match *) - -(* Exceptions are compatible with extensions *) - -module M : sig - type exn += Foo of int * float | Bar : 'a list -> exn -end = struct - exception Bar : 'a list -> exn - exception Foo of int * float -end - -module M : sig - exception Bar : 'a list -> exn - exception Foo of int * float -end = struct - type exn += Foo of int * float | Bar : 'a list -> exn -end - -exception Foo of int * float -exception Bar : 'a list -> exn - -module M : sig - type exn += Foo of int * float | Bar : 'a list -> exn -end = struct - exception Bar = Bar - exception Foo = Foo -end - -(* Test toplevel printing *) - -type foo = .. -type foo += Foo of int * int option | Bar of int option - -let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully *) - -type foo += Foo of string - -let y = x (* Prints Bar but not Foo (which has been shadowed) *) - -exception Foo of int * int option -exception Bar of int option - -let x = Foo (3, Some 4), Bar (Some 5) (* Prints Foo and Bar successfully *) - -type foo += Foo of string - -let y = x (* Prints Bar and part of Foo (which has been shadowed) *) - -(* Test Obj functions *) - -type foo = .. -type foo += Foo | Bar of int - -let extension_name e = Obj.extension_name (Obj.extension_constructor e) -let extension_id e = Obj.extension_id (Obj.extension_constructor e) -let n1 = extension_name Foo -let n2 = extension_name (Bar 1) -let t = extension_id (Bar 2) = extension_id (Bar 3) (* true *) -let f = extension_id (Bar 2) = extension_id Foo (* false *) -let is_foo x = extension_id Foo = extension_id x - -type foo += Foo - -let f = is_foo Foo -let _ = Obj.extension_constructor 7 (* Invald_arg *) - -let _ = - Obj.extension_constructor - (object - method m = 3 - end) -;; - -(* Invald_arg *) - -(* Typed names *) - -module Msg : sig - type 'a tag - type result = Result : 'a tag * 'a -> result - - val write : 'a tag -> 'a -> unit - val read : unit -> result - - type 'a tag += Int : int tag - - module type Desc = sig - type t - - val label : string - val write : t -> string - val read : string -> t - end - - module Define (D : Desc) : sig - type 'a tag += C : D.t tag - end -end = struct - type 'a tag = .. - type ktag = T : 'a tag -> ktag - - type 'a kind = - { tag : 'a tag - ; label : string - ; write : 'a -> string - ; read : string -> 'a - } - - type rkind = K : 'a kind -> rkind - type wkind = { f : 'a. 'a tag -> 'a kind } - - let readTbl : (string, rkind) Hashtbl.t = Hashtbl.create 13 - let writeTbl : (ktag, wkind) Hashtbl.t = Hashtbl.create 13 - let read_raw () : string * string = raise (Failure "Not implemented") - - type result = Result : 'a tag * 'a -> result - - let read () = - let label, content = read_raw () in - let (K k) = Hashtbl.find readTbl label in - let body = k.read content in - Result (k.tag, body) - ;; - - let write_raw (label : string) (content : string) = raise (Failure "Not implemented") - - let write (tag : 'a tag) (body : 'a) = - let { f } = Hashtbl.find writeTbl (T tag) in - let k = f tag in - let content = k.write body in - write_raw k.label content - ;; - - (* Add int kind *) - - type 'a tag += Int : int tag - - let ik = { tag = Int; label = "int"; write = string_of_int; read = int_of_string } - let () = Hashtbl.add readTbl "int" (K ik) - - let () = - let f (type t) (i : t tag) : t kind = - match i with - | Int -> ik - | _ -> assert false - in - Hashtbl.add writeTbl (T Int) { f } - ;; - - (* Support user defined kinds *) - - module type Desc = sig - type t - - val label : string - val write : t -> string - val read : string -> t - end - - module Define (D : Desc) = struct - type 'a tag += C : D.t tag - - let k = { tag = C; label = D.label; write = D.write; read = D.read } - let () = Hashtbl.add readTbl D.label (K k) - - let () = - let f (type t) (c : t tag) : t kind = - match c with - | C -> k - | _ -> assert false - in - Hashtbl.add writeTbl (T C) { f } - ;; - end -end - -let write_int i = Msg.write Msg.Int i - -module StrM = Msg.Define (struct - type t = string - - let label = "string" - let read s = s - let write s = s - end) - -type 'a Msg.tag += String = StrM.C - -let write_string s = Msg.write String s - -let read_one () = - let (Msg.Result (tag, body)) = Msg.read () in - match tag with - | Msg.Int -> print_int body - | String -> print_string body - | _ -> print_string "Unknown" -;; - -(* Example of algorithm parametrized with modules *) - -let sort (type s) set l = - let module Set = (val set : Set.S with type elt = s) in - Set.elements (List.fold_right Set.add l Set.empty) -;; - -let make_set (type s) cmp = - let module S = - Set.Make (struct - type t = s - - let compare = cmp - end) - in - (module S : Set.S with type elt = s) -;; - -let both l = - List.map (fun set -> sort set l) [ make_set compare; make_set (fun x y -> compare y x) ] -;; - -let () = - print_endline - (String.concat " " (List.map (String.concat "/") (both [ "abc"; "xyz"; "def" ]))) -;; - -(* Hiding the internal representation *) - -module type S = sig - type t - - val to_string : t -> string - val apply : t -> t - val x : t -end - -let create (type s) to_string apply x = - let module M = struct - type t = s - - let to_string = to_string - let apply = apply - let x = x - end - in - (module M : S with type t = s) -;; - -let forget (type s) x = - let module M = (val x : S with type t = s) in - (module M : S) -;; - -let print x = - let module M = (val x : S) in - print_endline (M.to_string M.x) -;; - -let apply x = - let module M = (val x : S) in - let module N = struct - include M - - let x = apply x - end - in - (module N : S) -;; - -let () = - let int = forget (create string_of_int succ 0) in - let str = forget (create (fun s -> s) (fun s -> s ^ s) "X") in - List.iter print (List.map apply [ int; apply int; apply (apply str) ]) -;; - -(* Existential types + type equality witnesses -> pseudo GADT *) - -module TypEq : sig - type ('a, 'b) t - - val apply : ('a, 'b) t -> 'a -> 'b - val refl : ('a, 'a) t - val sym : ('a, 'b) t -> ('b, 'a) t -end = struct - type ('a, 'b) t = unit - - let apply _ = Obj.magic - let refl = () - let sym () = () -end - -module rec Typ : sig - module type PAIR = sig - type t - type t1 - type t2 - - val eq : (t, t1 * t2) TypEq.t - val t1 : t1 Typ.typ - val t2 : t2 Typ.typ - end - - type 'a typ = - | Int of ('a, int) TypEq.t - | String of ('a, string) TypEq.t - | Pair of (module PAIR with type t = 'a) -end = struct - module type PAIR = sig - type t - type t1 - type t2 - - val eq : (t, t1 * t2) TypEq.t - val t1 : t1 Typ.typ - val t2 : t2 Typ.typ - end - - type 'a typ = - | Int of ('a, int) TypEq.t - | String of ('a, string) TypEq.t - | Pair of (module PAIR with type t = 'a) -end - -open Typ - -let int = Int TypEq.refl -let str = String TypEq.refl - -let pair (type s1) (type s2) t1 t2 = - let module P = struct - type t = s1 * s2 - type t1 = s1 - type t2 = s2 - - let eq = TypEq.refl - let t1 = t1 - let t2 = t2 - end - in - let pair = (module P : PAIR with type t = s1 * s2) in - Pair pair -;; - -module rec Print : sig - val to_string : 'a Typ.typ -> 'a -> string -end = struct - let to_string (type s) t x = - match t with - | Int eq -> string_of_int (TypEq.apply eq x) - | String eq -> Printf.sprintf "%S" (TypEq.apply eq x) - | Pair p -> - let module P = (val p : PAIR with type t = s) in - let x1, x2 = TypEq.apply P.eq x in - Printf.sprintf "(%s,%s)" (Print.to_string P.t1 x1) (Print.to_string P.t2 x2) - ;; -end - -let () = - print_endline (Print.to_string int 10); - print_endline (Print.to_string (pair int (pair str int)) (123, ("A", 456))) -;; - -(* #6262: first-class modules and module type aliases *) - -module type S1 = sig end -module type S2 = S1 - -let _f (x : (module S1)) : (module S2) = x - -module X = struct - module type S -end - -module Y = struct - include X -end - -let _f (x : (module X.S)) : (module Y.S) = x - -(* PR#6194, main example *) -module type S3 = sig - val x : bool -end - -let f = function - | Some (module M : S3) when M.x -> 1 - | ((Some _) [@foooo]) -> 2 - | None -> 3 -;; - -print_endline - (string_of_int - (f - (Some - (module struct - let x = false - end)))) - -type 'a ty = - | Int : int ty - | Bool : bool ty - -let fbool (type t) (x : t) (tag : t ty) = - match tag with - | Bool -> x -;; - -(* val fbool : 'a -> 'a ty -> 'a = <fun> *) - -(** OK: the return value is x of type t **) - -let fint (type t) (x : t) (tag : t ty) = - match tag with - | Int -> x > 0 -;; - -(* val fint : 'a -> 'a ty -> bool = <fun> *) - -(** OK: the return value is x > 0 of type bool; - This has used the equation t = bool, not visible in the return type **) - -let f (type t) (x : t) (tag : t ty) = - match tag with - | Int -> x > 0 - | Bool -> x -;; - -(* val f : 'a -> 'a ty -> bool = <fun> *) - -let g (type t) (x : t) (tag : t ty) = - match tag with - | Bool -> x - | Int -> x > 0 -;; - -(* Error: This expression has type bool but an expression was expected of type - t = int *) - -let id x = x - -let idb1 = - (fun id -> - let _ = id true in - id) - id -;; - -let idb2 : bool -> bool = id -let idb3 (_ : bool) = false - -let g (type t) (x : t) (tag : t ty) = - match tag with - | Bool -> idb3 x - | Int -> x > 0 -;; - -let g (type t) (x : t) (tag : t ty) = - match tag with - | Bool -> idb2 x - | Int -> x > 0 -;; - -(* Encoding generics using GADTs *) -(* (c) Alain Frisch / Lexifi *) -(* cf. http://www.lexifi.com/blog/dynamic-types *) - -(* Basic tag *) - -type 'a ty = - | Int : int ty - | String : string ty - | List : 'a ty -> 'a list ty - | Pair : ('a ty * 'b ty) -> ('a * 'b) ty - -(* Tagging data *) - -type variant = - | VInt of int - | VString of string - | VList of variant list - | VPair of variant * variant - -let rec variantize : type t. t ty -> t -> variant = - fun ty x -> - (* type t is abstract here *) - match ty with - | Int -> VInt x (* in this branch: t = int *) - | String -> VString x (* t = string *) - | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a *) - | Pair (ty1, ty2) -> VPair (variantize ty1 (fst x), variantize ty2 (snd x)) -;; - -(* t = ('a, 'b) for some 'a and 'b *) - -exception VariantMismatch - -let rec devariantize : type t. t ty -> variant -> t = - fun ty v -> - match ty, v with - | Int, VInt x -> x - | String, VString x -> x - | List ty1, VList vl -> List.map (devariantize ty1) vl - | Pair (ty1, ty2), VPair (x1, x2) -> devariantize ty1 x1, devariantize ty2 x2 - | _ -> raise VariantMismatch -;; - -(* Handling records *) - -type 'a ty = - | Int : int ty - | String : string ty - | List : 'a ty -> 'a list ty - | Pair : ('a ty * 'b ty) -> ('a * 'b) ty - | Record : 'a record -> 'a ty - -and 'a record = - { path : string - ; fields : 'a field_ list - } - -and 'a field_ = Field : ('a, 'b) field -> 'a field_ - -and ('a, 'b) field = - { label : string - ; field_type : 'b ty - ; get : 'a -> 'b - } - -(* Again *) - -type variant = - | VInt of int - | VString of string - | VList of variant list - | VPair of variant * variant - | VRecord of (string * variant) list - -let rec variantize : type t. t ty -> t -> variant = - fun ty x -> - (* type t is abstract here *) - match ty with - | Int -> VInt x (* in this branch: t = int *) - | String -> VString x (* t = string *) - | List ty1 -> VList (List.map (variantize ty1) x) (* t = 'a list for some 'a *) - | Pair (ty1, ty2) -> - VPair (variantize ty1 (fst x), variantize ty2 (snd x)) - (* t = ('a, 'b) for some 'a and 'b *) - | Record { fields } -> - VRecord - (List.map - (fun (Field { field_type; label; get }) -> label, variantize field_type (get x)) - fields) -;; - -(* Extraction *) - -type 'a ty = - | Int : int ty - | String : string ty - | List : 'a ty -> 'a list ty - | Pair : ('a ty * 'b ty) -> ('a * 'b) ty - | Record : ('a, 'builder) record -> 'a ty - -and ('a, 'builder) record = - { path : string - ; fields : ('a, 'builder) field list - ; create_builder : unit -> 'builder - ; of_builder : 'builder -> 'a - } - -and ('a, 'builder) field = Field : ('a, 'builder, 'b) field_ -> ('a, 'builder) field - -and ('a, 'builder, 'b) field_ = - { label : string - ; field_type : 'b ty - ; get : 'a -> 'b - ; set : 'builder -> 'b -> unit - } - -let rec devariantize : type t. t ty -> variant -> t = - fun ty v -> - match ty, v with - | Int, VInt x -> x - | String, VString x -> x - | List ty1, VList vl -> List.map (devariantize ty1) vl - | Pair (ty1, ty2), VPair (x1, x2) -> devariantize ty1 x1, devariantize ty2 x2 - | Record { fields; create_builder; of_builder }, VRecord fl -> - if List.length fields <> List.length fl then raise VariantMismatch; - let builder = create_builder () in - List.iter2 - (fun (Field { label; field_type; set }) (lab, v) -> - if label <> lab then raise VariantMismatch; - set builder (devariantize field_type v)) - fields - fl; - of_builder builder - | _ -> raise VariantMismatch -;; - -type my_record = - { a : int - ; b : string list - } - -let my_record = - let fields = - [ Field - { label = "a" - ; field_type = Int - ; get = (fun { a } -> a) - ; set = (fun (r, _) x -> r := Some x) - } - ; Field - { label = "b" - ; field_type = List String - ; get = (fun { b } -> b) - ; set = (fun (_, r) x -> r := Some x) - } - ] - in - let create_builder () = ref None, ref None in - let of_builder (a, b) = - match !a, !b with - | Some a, Some b -> { a; b } - | _ -> failwith "Some fields are missing in record of type my_record" - in - Record { path = "My_module.my_record"; fields; create_builder; of_builder } -;; - -(* Extension to recursive types and polymorphic variants *) -(* by Jacques Garrigue *) - -type noarg = Noarg - -type (_, _) ty = - | Int : (int, _) ty - | String : (string, _) ty - | List : ('a, 'e) ty -> ('a list, 'e) ty - | Option : ('a, 'e) ty -> ('a option, 'e) ty - | Pair : (('a, 'e) ty * ('b, 'e) ty) -> ('a * 'b, 'e) ty - (* Support for type variables and recursive types *) - | Var : ('a, 'a -> 'e) ty - | Rec : ('a, 'a -> 'e) ty -> ('a, 'e) ty - | Pop : ('a, 'e) ty -> ('a, 'b -> 'e) ty - (* Change the representation of a type *) - | Conv : string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty - (* Sum types (both normal sums and polymorphic variants) *) - | Sum : ('a, 'e, 'b) ty_sum -> ('a, 'e) ty - -and ('a, 'e, 'b) ty_sum = - { sum_proj : 'a -> string * 'e ty_dyn option - ; sum_cases : (string * ('e, 'b) ty_case) list - ; sum_inj : 'c. ('b, 'c) ty_sel * 'c -> 'a - } - -and 'e ty_dyn = - (* dynamic type *) - | Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn - -and (_, _) ty_sel = - (* selector from a list of types *) - | Thd : ('a -> 'b, 'a) ty_sel - | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel - -and (_, _) ty_case = - (* type a sum case *) - | TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case - | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case - -type _ ty_env = - (* type variable substitution *) - | Enil : unit ty_env - | Econs : ('a, 'e) ty * 'e ty_env -> ('a -> 'e) ty_env - -(* Comparing selectors *) -type (_, _) eq = Eq : ('a, 'a) eq - -let rec eq_sel : type a b c. (a, b) ty_sel -> (a, c) ty_sel -> (b, c) eq option = - fun s1 s2 -> - match s1, s2 with - | Thd, Thd -> Some Eq - | Ttl s1, Ttl s2 -> - (match eq_sel s1 s2 with - | None -> None - | Some Eq -> Some Eq) - | _ -> None -;; - -(* Auxiliary function to get the type of a case from its selector *) -let rec get_case - : type a b e. - (b, a) ty_sel -> (string * (e, b) ty_case) list -> string * (a, e) ty option - = - fun sel cases -> - match cases with - | (name, TCnoarg sel') :: rem -> - (match eq_sel sel sel' with - | None -> get_case sel rem - | Some Eq -> name, None) - | (name, TCarg (sel', ty)) :: rem -> - (match eq_sel sel sel' with - | None -> get_case sel rem - | Some Eq -> name, Some ty) - | [] -> raise Not_found -;; - -(* Untyped representation of values *) -type variant = - | VInt of int - | VString of string - | VList of variant list - | VOption of variant option - | VPair of variant * variant - | VConv of string * variant - | VSum of string * variant option - -let may_map f = function - | Some x -> Some (f x) - | None -> None -;; - -let rec variantize : type a e. e ty_env -> (a, e) ty -> a -> variant = - fun e ty v -> - match ty with - | Int -> VInt v - | String -> VString v - | List t -> VList (List.map (variantize e t) v) - | Option t -> VOption (may_map (variantize e t) v) - | Pair (t1, t2) -> VPair (variantize e t1 (fst v), variantize e t2 (snd v)) - | Rec t -> variantize (Econs (ty, e)) t v - | Pop t -> - (match e with - | Econs (_, e') -> variantize e' t v) - | Var -> - (match e with - | Econs (t, e') -> variantize e' t v) - | Conv (s, proj, inj, t) -> VConv (s, variantize e t (proj v)) - | Sum ops -> - let tag, arg = ops.sum_proj v in - VSum - ( tag - , may_map - (function - | Tdyn (ty, arg) -> variantize e ty arg) - arg ) -;; - -let rec devariantize : type t e. e ty_env -> (t, e) ty -> variant -> t = - fun e ty v -> - match ty, v with - | Int, VInt x -> x - | String, VString x -> x - | List ty1, VList vl -> List.map (devariantize e ty1) vl - | Pair (ty1, ty2), VPair (x1, x2) -> devariantize e ty1 x1, devariantize e ty2 x2 - | Rec t, _ -> devariantize (Econs (ty, e)) t v - | Pop t, _ -> - (match e with - | Econs (_, e') -> devariantize e' t v) - | Var, _ -> - (match e with - | Econs (t, e') -> devariantize e' t v) - | Conv (s, proj, inj, t), VConv (s', v) when s = s' -> inj (devariantize e t v) - | Sum ops, VSum (tag, a) -> - (try - match List.assoc tag ops.sum_cases, a with - | TCarg (sel, t), Some a -> ops.sum_inj (sel, devariantize e t a) - | TCnoarg sel, None -> ops.sum_inj (sel, Noarg) - | _ -> raise VariantMismatch - with - | Not_found -> raise VariantMismatch) - | _ -> raise VariantMismatch -;; - -(* First attempt: represent 1-constructor variants using Conv *) -let wrap_A t = Conv ("`A", (fun (`A x) -> x), (fun x -> `A x), t) -let ty a = Rec (wrap_A (Option (Pair (a, Var)))) -let v = variantize Enil (ty Int) -let x = v (`A (Some (1, `A (Some (2, `A None))))) - -(* Can also use it to decompose a tuple *) - -let triple t1 t2 t3 = - Conv - ( "Triple" - , (fun (a, b, c) -> a, (b, c)) - , (fun (a, (b, c)) -> a, b, c) - , Pair (t1, Pair (t2, t3)) ) -;; - -let v = variantize Enil (triple String Int Int) ("A", 2, 3) - -(* Second attempt: introduce a real sum construct *) -let ty_abc = - (* Could also use [get_case] for proj, but direct definition is shorter *) - let proj = function - | `A n -> "A", Some (Tdyn (Int, n)) - | `B s -> "B", Some (Tdyn (String, s)) - | `C -> "C", None - (* Define inj in advance to be able to write the type annotation easily *) - and inj - : type c. - (int -> string -> noarg -> unit, c) ty_sel * c -> [ `A of int | `B of string | `C ] - = function - | Thd, v -> `A v - | Ttl Thd, v -> `B v - | Ttl (Ttl Thd), Noarg -> `C - in - (* Coherence of sum_inj and sum_cases is checked by the typing *) - Sum - { sum_proj = proj - ; sum_inj = inj - ; sum_cases = - [ "A", TCarg (Thd, Int) - ; "B", TCarg (Ttl Thd, String) - ; "C", TCnoarg (Ttl (Ttl Thd)) - ] - } -;; - -let v = variantize Enil ty_abc (`A 3) -let a = devariantize Enil ty_abc v - -(* And an example with recursion... *) -type 'a vlist = - [ `Nil - | `Cons of 'a * 'a vlist - ] - -let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = - fun t -> - let tcons = Pair (Pop t, Var) in - Rec - (Sum - { sum_proj = - (function - | `Nil -> "Nil", None - | `Cons p -> "Cons", Some (Tdyn (tcons, p))) - ; sum_cases = [ "Nil", TCnoarg Thd; "Cons", TCarg (Ttl Thd, tcons) ] - ; sum_inj = - (fun (type c) -> - (function - | Thd, Noarg -> `Nil - | Ttl Thd, v -> `Cons v - : (noarg -> a * a vlist -> unit, c) ty_sel * c -> a vlist)) - (* One can also write the type annotation directly *) - }) -;; - -let v = variantize Enil (ty_list Int) (`Cons (1, `Cons (2, `Nil))) - -(* Simpler but weaker approach *) - -type (_, _) ty = - | Int : (int, _) ty - | String : (string, _) ty - | List : ('a, 'e) ty -> ('a list, 'e) ty - | Option : ('a, 'e) ty -> ('a option, 'e) ty - | Pair : (('a, 'e) ty * ('b, 'e) ty) -> ('a * 'b, 'e) ty - | Var : ('a, 'a -> 'e) ty - | Rec : ('a, 'a -> 'e) ty -> ('a, 'e) ty - | Pop : ('a, 'e) ty -> ('a, 'b -> 'e) ty - | Conv : string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty - | Sum : - ('a -> string * 'e ty_dyn option) * (string * 'e ty_dyn option -> 'a) - -> ('a, 'e) ty - -and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn - -let ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = - (* Could also use [get_case] for proj, but direct definition is shorter *) - Sum - ( (function - | `A n -> "A", Some (Tdyn (Int, n)) - | `B s -> "B", Some (Tdyn (String, s)) - | `C -> "C", None) - , function - | "A", Some (Tdyn (Int, n)) -> `A n - | "B", Some (Tdyn (String, s)) -> `B s - | "C", None -> `C - | _ -> invalid_arg "ty_abc" ) -;; - -(* Breaks: no way to pattern-match on a full recursive type *) -let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = - fun t -> - let targ = Pair (Pop t, Var) in - Rec - (Sum - ( (function - | `Nil -> "Nil", None - | `Cons p -> "Cons", Some (Tdyn (targ, p))) - , function - | "Nil", None -> `Nil - | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> `Cons p )) -;; - -(* Define Sum using object instead of record for first-class polymorphism *) - -type (_, _) ty = - | Int : (int, _) ty - | String : (string, _) ty - | List : ('a, 'e) ty -> ('a list, 'e) ty - | Option : ('a, 'e) ty -> ('a option, 'e) ty - | Pair : (('a, 'e) ty * ('b, 'e) ty) -> ('a * 'b, 'e) ty - | Var : ('a, 'a -> 'e) ty - | Rec : ('a, 'a -> 'e) ty -> ('a, 'e) ty - | Pop : ('a, 'e) ty -> ('a, 'b -> 'e) ty - | Conv : string * ('a -> 'b) * ('b -> 'a) * ('b, 'e) ty -> ('a, 'e) ty - | Sum : - < proj : 'a -> string * 'e ty_dyn option - ; cases : (string * ('e, 'b) ty_case) list - ; inj : 'c. ('b, 'c) ty_sel * 'c -> 'a > - -> ('a, 'e) ty - -and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn - -and (_, _) ty_sel = - | Thd : ('a -> 'b, 'a) ty_sel - | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel - -and (_, _) ty_case = - | TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case - | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case - -let ty_abc : (([ `A of int | `B of string | `C ] as 'a), 'e) ty = - Sum - (object - method proj = - function - | `A n -> "A", Some (Tdyn (Int, n)) - | `B s -> "B", Some (Tdyn (String, s)) - | `C -> "C", None - - method cases = - [ "A", TCarg (Thd, Int) - ; "B", TCarg (Ttl Thd, String) - ; "C", TCnoarg (Ttl (Ttl Thd)) - ] - - method inj - : type c. - (int -> string -> noarg -> unit, c) ty_sel * c - -> [ `A of int | `B of string | `C ] = - function - | Thd, v -> `A v - | Ttl Thd, v -> `B v - | Ttl (Ttl Thd), Noarg -> `C - end) -;; - -type 'a vlist = - [ `Nil - | `Cons of 'a * 'a vlist - ] - -let ty_list : type a e. (a, e) ty -> (a vlist, e) ty = - fun t -> - let tcons = Pair (Pop t, Var) in - Rec - (Sum - (object - method proj = - function - | `Nil -> "Nil", None - | `Cons p -> "Cons", Some (Tdyn (tcons, p)) - - method cases = [ "Nil", TCnoarg Thd; "Cons", TCarg (Ttl Thd, tcons) ] - - method inj : type c. (noarg -> a * a vlist -> unit, c) ty_sel * c -> a vlist = - function - | Thd, Noarg -> `Nil - | Ttl Thd, v -> `Cons v - end)) -;; - -(* - type (_,_) ty_assoc = - | Anil : (unit,'e) ty_assoc - | Acons : string * ('a,'e) ty * ('b,'e) ty_assoc -> ('a -> 'b, 'e) ty_assoc - - and (_,_) ty_pvar = - | Pnil : ('a,'e) ty_pvar - | Pconst : 't * ('b,'e) ty_pvar -> ('t -> 'b, 'e) ty_pvar - | Parg : 't * ('a,'e) ty * ('b,'e) ty_pvar -> ('t * 'a -> 'b, 'e) ty_pvar -*) -(* - An attempt at encoding omega examples from the 2nd Central European - Functional Programming School: - Generic Programming in Omega, by Tim Sheard and Nathan Linger - http://web.cecs.pdx.edu/~sheard/ -*) - -(* Basic types *) - -type ('a, 'b) sum = - | Inl of 'a - | Inr of 'b - -type zero = Zero -type 'a succ = Succ of 'a - -type _ nat = - | NZ : zero nat - | NS : 'a nat -> 'a succ nat - -(* 2: A simple example *) - -type (_, _) seq = - | Snil : ('a, zero) seq - | Scons : 'a * ('a, 'n) seq -> ('a, 'n succ) seq - -let l1 = Scons (3, Scons (5, Snil)) - -(* We do not have type level functions, so we need to use witnesses. *) -(* We copy here the definitions from section 3.9 *) -(* Note the addition of the ['a nat] argument to PlusZ, since we do not - have kinds *) -type (_, _, _) plus = - | PlusZ : 'a nat -> (zero, 'a, 'a) plus - | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus - -let rec length : type a n. (a, n) seq -> n nat = function - | Snil -> NZ - | Scons (_, s) -> NS (length s) -;; - -(* app returns the catenated lists with a witness proving that - the size is the sum of its two inputs *) -type (_, _, _) app = App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app - -let rec app : type a n m. (a, n) seq -> (a, m) seq -> (a, n, m) app = - fun xs ys -> - match xs with - | Snil -> App (ys, PlusZ (length ys)) - | Scons (x, xs') -> - let (App (xs'', pl)) = app xs' ys in - App (Scons (x, xs''), PlusS pl) -;; - -(* 3.1 Feature: kinds *) - -(* We do not have kinds, but we can encode them as predicates *) - -type tp = TP -type nd = ND -type ('a, 'b) fk = FK - -type _ shape = - | Tp : tp shape - | Nd : nd shape - | Fk : 'a shape * 'b shape -> ('a, 'b) fk shape - -type tt = TT -type ff = FF - -type _ boolean = - | BT : tt boolean - | BF : ff boolean - -(* 3.3 Feature : GADTs *) - -type (_, _) path = - | Pnone : 'a -> (tp, 'a) path - | Phere : (nd, 'a) path - | Pleft : ('x, 'a) path -> (('x, 'y) fk, 'a) path - | Pright : ('y, 'a) path -> (('x, 'y) fk, 'a) path - -type (_, _) tree = - | Ttip : (tp, 'a) tree - | Tnode : 'a -> (nd, 'a) tree - | Tfork : ('x, 'a) tree * ('y, 'a) tree -> (('x, 'y) fk, 'a) tree - -let tree1 = Tfork (Tfork (Ttip, Tnode 4), Tfork (Tnode 4, Tnode 3)) - -let rec find : type sh. ('a -> 'a -> bool) -> 'a -> (sh, 'a) tree -> (sh, 'a) path list = - fun eq n t -> - match t with - | Ttip -> [] - | Tnode m -> if eq n m then [ Phere ] else [] - | Tfork (x, y) -> - List.map (fun x -> Pleft x) (find eq n x) @ List.map (fun x -> Pright x) (find eq n y) -;; - -let rec extract : type sh. (sh, 'a) path -> (sh, 'a) tree -> 'a = - fun p t -> - match p, t with - | Pnone x, Ttip -> x - | Phere, Tnode y -> y - | Pleft p, Tfork (l, _) -> extract p l - | Pright p, Tfork (_, r) -> extract p r -;; - -(* 3.4 Pattern : Witness *) - -type (_, _) le = - | LeZ : 'a nat -> (zero, 'a) le - | LeS : ('n, 'm) le -> ('n succ, 'm succ) le - -type _ even = - | EvenZ : zero even - | EvenSS : 'n even -> 'n succ succ even - -type one = zero succ -type two = one succ -type three = two succ -type four = three succ - -let even0 : zero even = EvenZ -let even2 : two even = EvenSS EvenZ -let even4 : four even = EvenSS (EvenSS EvenZ) -let p1 : (two, one, three) plus = PlusS (PlusS (PlusZ (NS NZ))) - -let rec summandLessThanSum : type a b c. (a, b, c) plus -> (a, c) le = - fun p -> - match p with - | PlusZ n -> LeZ n - | PlusS p' -> LeS (summandLessThanSum p') -;; - -(* 3.8 Pattern: Leibniz Equality *) - -type (_, _) equal = Eq : ('a, 'a) equal - -let convert : type a b. (a, b) equal -> a -> b = fun Eq x -> x - -let rec sameNat : type a b. a nat -> b nat -> (a, b) equal option = - fun a b -> - match a, b with - | NZ, NZ -> Some Eq - | NS a', NS b' -> - (match sameNat a' b' with - | Some Eq -> Some Eq - | None -> None) - | _ -> None -;; - -(* Extra: associativity of addition *) - -let rec plus_func : type a b m n. (a, b, m) plus -> (a, b, n) plus -> (m, n) equal = - fun p1 p2 -> - match p1, p2 with - | PlusZ _, PlusZ _ -> Eq - | PlusS p1', PlusS p2' -> - let Eq = plus_func p1' p2' in - Eq -;; - -let rec plus_assoc - : type a b c ab bc m n. - (a, b, ab) plus - -> (ab, c, m) plus - -> (b, c, bc) plus - -> (a, bc, n) plus - -> (m, n) equal - = - fun p1 p2 p3 p4 -> - match p1, p4 with - | PlusZ b, PlusZ bc -> - let Eq = plus_func p2 p3 in - Eq - | PlusS p1', PlusS p4' -> - let (PlusS p2') = p2 in - let Eq = plus_assoc p1' p2' p3 p4' in - Eq -;; - -(* 3.9 Computing Programs and Properties Simultaneously *) - -(* Plus and app1 are moved to section 2 *) - -let smaller : type a b. (a succ, b succ) le -> (a, b) le = function - | LeS x -> x -;; - -type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff - -(* - let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff = - fun le a b -> - match a, b, le with - | NZ, m, _ -> Diff (m, PlusZ m) - | NS x, NZ, _ -> assert false - | NS x, NS y, q -> - match diff (smaller q) x y with Diff (m, p) -> Diff (m, PlusS p) - ;; -*) - -let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff = - fun le a b -> - match le, a, b with - | LeZ _, _, m -> Diff (m, PlusZ m) - | LeS q, NS x, NS y -> - (match diff q x y with - | Diff (m, p) -> Diff (m, PlusS p)) -;; - -let rec diff : type a b. (a, b) le -> a nat -> b nat -> (a, b) diff = - fun le a b -> - match a, b, le with - (* warning *) - | NZ, m, LeZ _ -> Diff (m, PlusZ m) - | NS x, NS y, LeS q -> - (match diff q x y with - | Diff (m, p) -> Diff (m, PlusS p)) - | _ -> . -;; - -let rec diff : type a b. (a, b) le -> b nat -> (a, b) diff = - fun le b -> - match b, le with - | m, LeZ _ -> Diff (m, PlusZ m) - | NS y, LeS q -> - (match diff q y with - | Diff (m, p) -> Diff (m, PlusS p)) -;; - -type (_, _) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter - -let rec leS' : type m n. (m, n) le -> (m, n succ) le = function - | LeZ n -> LeZ (NS n) - | LeS le -> LeS (leS' le) -;; - -let rec filter : type a n. (a -> bool) -> (a, n) seq -> (a, n) filter = - fun f s -> - match s with - | Snil -> Filter (LeZ NZ, Snil) - | Scons (a, l) -> - (match filter f l with - | Filter (le, l') -> - if f a then Filter (LeS le, Scons (a, l')) else Filter (leS' le, l')) -;; - -(* 4.1 AVL trees *) - -type (_, _, _) balance = - | Less : ('h, 'h succ, 'h succ) balance - | Same : ('h, 'h, 'h) balance - | More : ('h succ, 'h, 'h succ) balance - -type _ avl = - | Leaf : zero avl - | Node : ('hL, 'hR, 'hMax) balance * 'hL avl * int * 'hR avl -> 'hMax succ avl - -type avl' = Avl : 'h avl -> avl' - -let empty = Avl Leaf - -let rec elem : type h. int -> h avl -> bool = - fun x t -> - match t with - | Leaf -> false - | Node (_, l, y, r) -> x = y || if x < y then elem x l else elem x r -;; - -let rec rotr - : type n. n succ succ avl -> int -> n avl -> (n succ succ avl, n succ succ succ avl) sum - = - fun tL y tR -> - match tL with - | Node (Same, a, x, b) -> Inr (Node (Less, a, x, Node (More, b, y, tR))) - | Node (More, a, x, b) -> Inl (Node (Same, a, x, Node (Same, b, y, tR))) - | Node (Less, a, x, Node (Same, b, z, c)) -> - Inl (Node (Same, Node (Same, a, x, b), z, Node (Same, c, y, tR))) - | Node (Less, a, x, Node (Less, b, z, c)) -> - Inl (Node (Same, Node (More, a, x, b), z, Node (Same, c, y, tR))) - | Node (Less, a, x, Node (More, b, z, c)) -> - Inl (Node (Same, Node (Same, a, x, b), z, Node (Less, c, y, tR))) -;; - -let rec rotl - : type n. n avl -> int -> n succ succ avl -> (n succ succ avl, n succ succ succ avl) sum - = - fun tL u tR -> - match tR with - | Node (Same, a, x, b) -> Inr (Node (More, Node (Less, tL, u, a), x, b)) - | Node (Less, a, x, b) -> Inl (Node (Same, Node (Same, tL, u, a), x, b)) - | Node (More, Node (Same, a, x, b), y, c) -> - Inl (Node (Same, Node (Same, tL, u, a), x, Node (Same, b, y, c))) - | Node (More, Node (Less, a, x, b), y, c) -> - Inl (Node (Same, Node (More, tL, u, a), x, Node (Same, b, y, c))) - | Node (More, Node (More, a, x, b), y, c) -> - Inl (Node (Same, Node (Same, tL, u, a), x, Node (Less, b, y, c))) -;; - -let rec ins : type n. int -> n avl -> (n avl, n succ avl) sum = - fun x t -> - match t with - | Leaf -> Inr (Node (Same, Leaf, x, Leaf)) - | Node (bal, a, y, b) -> - if x = y - then Inl t - else if x < y - then ( - match ins x a with - | Inl a -> Inl (Node (bal, a, y, b)) - | Inr a -> - (match bal with - | Less -> Inl (Node (Same, a, y, b)) - | Same -> Inr (Node (More, a, y, b)) - | More -> rotr a y b)) - else ( - match ins x b with - | Inl b -> Inl (Node (bal, a, y, b) : n avl) - | Inr b -> - (match bal with - | More -> Inl (Node (Same, a, y, b) : n avl) - | Same -> Inr (Node (Less, a, y, b) : n succ avl) - | Less -> rotl a y b)) -;; - -let insert x (Avl t) = - match ins x t with - | Inl t -> Avl t - | Inr t -> Avl t -;; - -let rec del_min : type n. n succ avl -> int * (n avl, n succ avl) sum = function - | Node (Less, Leaf, x, r) -> x, Inl r - | Node (Same, Leaf, x, r) -> x, Inl r - | Node (bal, (Node _ as l), x, r) -> - (match del_min l with - | y, Inr l -> y, Inr (Node (bal, l, x, r)) - | y, Inl l -> - ( y - , (match bal with - | Same -> Inr (Node (Less, l, x, r)) - | More -> Inl (Node (Same, l, x, r)) - | Less -> rotl l x r) )) -;; - -type _ avl_del = - | Dsame : 'n avl -> 'n avl_del - | Ddecr : ('m succ, 'n) equal * 'm avl -> 'n avl_del - -let rec del : type n. int -> n avl -> n avl_del = - fun y t -> - match t with - | Leaf -> Dsame Leaf - | Node (bal, l, x, r) -> - if x = y - then ( - match r with - | Leaf -> - (match bal with - | Same -> Ddecr (Eq, l) - | More -> Ddecr (Eq, l)) - | Node _ -> - (match bal, del_min r with - | _, (z, Inr r) -> Dsame (Node (bal, l, z, r)) - | Same, (z, Inl r) -> Dsame (Node (More, l, z, r)) - | Less, (z, Inl r) -> Ddecr (Eq, Node (Same, l, z, r)) - | More, (z, Inl r) -> - (match rotr l z r with - | Inl t -> Ddecr (Eq, t) - | Inr t -> Dsame t))) - else if y < x - then ( - match del y l with - | Dsame l -> Dsame (Node (bal, l, x, r)) - | Ddecr (Eq, l) -> - (match bal with - | Same -> Dsame (Node (Less, l, x, r)) - | More -> Ddecr (Eq, Node (Same, l, x, r)) - | Less -> - (match rotl l x r with - | Inl t -> Ddecr (Eq, t) - | Inr t -> Dsame t))) - else ( - match del y r with - | Dsame r -> Dsame (Node (bal, l, x, r)) - | Ddecr (Eq, r) -> - (match bal with - | Same -> Dsame (Node (More, l, x, r)) - | Less -> Ddecr (Eq, Node (Same, l, x, r)) - | More -> - (match rotr l x r with - | Inl t -> Ddecr (Eq, t) - | Inr t -> Dsame t))) -;; - -let delete x (Avl t) = - match del x t with - | Dsame t -> Avl t - | Ddecr (_, t) -> Avl t -;; - -(* Exercise 22: Red-black trees *) - -type red = RED -type black = BLACK - -type (_, _) sub_tree = - | Bleaf : (black, zero) sub_tree - | Rnode : (black, 'n) sub_tree * int * (black, 'n) sub_tree -> (red, 'n) sub_tree - | Bnode : ('cL, 'n) sub_tree * int * ('cR, 'n) sub_tree -> (black, 'n succ) sub_tree - -type rb_tree = Root : (black, 'n) sub_tree -> rb_tree - -type dir = - | LeftD - | RightD - -type (_, _) ctxt = - | CNil : (black, 'n) ctxt - | CRed : int * dir * (black, 'n) sub_tree * (red, 'n) ctxt -> (black, 'n) ctxt - | CBlk : int * dir * ('c1, 'n) sub_tree * (black, 'n succ) ctxt -> ('c, 'n) ctxt - -let blacken = function - | Rnode (l, e, r) -> Bnode (l, e, r) -;; - -type _ crep = - | Red : red crep - | Black : black crep - -let color : type c n. (c, n) sub_tree -> c crep = function - | Bleaf -> Black - | Rnode _ -> Red - | Bnode _ -> Black -;; - -let rec fill : type c n. (c, n) ctxt -> (c, n) sub_tree -> rb_tree = - fun ct t -> - match ct with - | CNil -> Root t - | CRed (e, LeftD, uncle, c) -> fill c (Rnode (uncle, e, t)) - | CRed (e, RightD, uncle, c) -> fill c (Rnode (t, e, uncle)) - | CBlk (e, LeftD, uncle, c) -> fill c (Bnode (uncle, e, t)) - | CBlk (e, RightD, uncle, c) -> fill c (Bnode (t, e, uncle)) -;; - -let recolor d1 pE sib d2 gE uncle t = - match d1, d2 with - | LeftD, RightD -> Rnode (Bnode (sib, pE, t), gE, uncle) - | RightD, RightD -> Rnode (Bnode (t, pE, sib), gE, uncle) - | LeftD, LeftD -> Rnode (uncle, gE, Bnode (sib, pE, t)) - | RightD, LeftD -> Rnode (uncle, gE, Bnode (t, pE, sib)) -;; - -let rotate d1 pE sib d2 gE uncle (Rnode (x, e, y)) = - match d1, d2 with - | RightD, RightD -> Bnode (Rnode (x, e, y), pE, Rnode (sib, gE, uncle)) - | LeftD, RightD -> Bnode (Rnode (sib, pE, x), e, Rnode (y, gE, uncle)) - | LeftD, LeftD -> Bnode (Rnode (uncle, gE, sib), pE, Rnode (x, e, y)) - | RightD, LeftD -> Bnode (Rnode (uncle, gE, x), e, Rnode (y, pE, sib)) -;; - -let rec repair : type c n. (red, n) sub_tree -> (c, n) ctxt -> rb_tree = - fun t ct -> - match ct with - | CNil -> Root (blacken t) - | CBlk (e, LeftD, sib, c) -> fill c (Bnode (sib, e, t)) - | CBlk (e, RightD, sib, c) -> fill c (Bnode (t, e, sib)) - | CRed (e, dir, sib, CBlk (e', dir', uncle, ct)) -> - (match color uncle with - | Red -> repair (recolor dir e sib dir' e' (blacken uncle) t) ct - | Black -> fill ct (rotate dir e sib dir' e' uncle t)) -;; - -let rec ins : type c n. int -> (c, n) sub_tree -> (c, n) ctxt -> rb_tree = - fun e t ct -> - match t with - | Rnode (l, e', r) -> - if e < e' - then ins e l (CRed (e', RightD, r, ct)) - else ins e r (CRed (e', LeftD, l, ct)) - | Bnode (l, e', r) -> - if e < e' - then ins e l (CBlk (e', RightD, r, ct)) - else ins e r (CBlk (e', LeftD, l, ct)) - | Bleaf -> repair (Rnode (Bleaf, e, Bleaf)) ct -;; - -let insert e (Root t) = ins e t CNil - -(* 5.7 typed object languages using GADTs *) - -type _ term = - | Const : int -> int term - | Add : (int * int -> int) term - | LT : (int * int -> bool) term - | Ap : ('a -> 'b) term * 'a term -> 'b term - | Pair : 'a term * 'b term -> ('a * 'b) term - -let ex1 = Ap (Add, Pair (Const 3, Const 5)) -let ex2 = Pair (ex1, Const 1) - -let rec eval_term : type a. a term -> a = function - | Const x -> x - | Add -> fun (x, y) -> x + y - | LT -> fun (x, y) -> x < y - | Ap (f, x) -> eval_term f (eval_term x) - | Pair (x, y) -> eval_term x, eval_term y -;; - -type _ rep = - | Rint : int rep - | Rbool : bool rep - | Rpair : 'a rep * 'b rep -> ('a * 'b) rep - | Rfun : 'a rep * 'b rep -> ('a -> 'b) rep - -type (_, _) equal = Eq : ('a, 'a) equal - -let rec rep_equal : type a b. a rep -> b rep -> (a, b) equal option = - fun ra rb -> - match ra, rb with - | Rint, Rint -> Some Eq - | Rbool, Rbool -> Some Eq - | Rpair (a1, a2), Rpair (b1, b2) -> - (match rep_equal a1 b1 with - | None -> None - | Some Eq -> - (match rep_equal a2 b2 with - | None -> None - | Some Eq -> Some Eq)) - | Rfun (a1, a2), Rfun (b1, b2) -> - (match rep_equal a1 b1 with - | None -> None - | Some Eq -> - (match rep_equal a2 b2 with - | None -> None - | Some Eq -> Some Eq)) - | _ -> None -;; - -type assoc = Assoc : string * 'a rep * 'a -> assoc - -let rec assoc : type a. string -> a rep -> assoc list -> a = - fun x r -> function - | [] -> raise Not_found - | Assoc (x', r', v) :: env -> - if x = x' - then ( - match rep_equal r r' with - | None -> failwith ("Wrong type for " ^ x) - | Some Eq -> v) - else assoc x r env -;; - -type _ term = - | Var : string * 'a rep -> 'a term - | Abs : string * 'a rep * 'b term -> ('a -> 'b) term - | Const : int -> int term - | Add : (int * int -> int) term - | LT : (int * int -> bool) term - | Ap : ('a -> 'b) term * 'a term -> 'b term - | Pair : 'a term * 'b term -> ('a * 'b) term - -let rec eval_term : type a. assoc list -> a term -> a = - fun env -> function - | Var (x, r) -> assoc x r env - | Abs (x, r, e) -> fun v -> eval_term (Assoc (x, r, v) :: env) e - | Const x -> x - | Add -> fun (x, y) -> x + y - | LT -> fun (x, y) -> x < y - | Ap (f, x) -> eval_term env f (eval_term env x) - | Pair (x, y) -> eval_term env x, eval_term env y -;; - -let ex3 = Abs ("x", Rint, Ap (Add, Pair (Var ("x", Rint), Var ("x", Rint)))) -let ex4 = Ap (ex3, Const 3) -let v4 = eval_term [] ex4 - -(* 5.9/5.10 Language with binding *) - -type rnil = RNIL -type ('a, 'b, 'c) rcons = RCons of 'a * 'b * 'c - -type _ is_row = - | Rnil : rnil is_row - | Rcons : 'c is_row -> ('a, 'b, 'c) rcons is_row - -type (_, _) lam = - | Const : int -> ('e, int) lam - | Var : 'a -> (('a, 't, 'e) rcons, 't) lam - | Shift : ('e, 't) lam -> (('a, 'q, 'e) rcons, 't) lam - | Abs : 'a * (('a, 's, 'e) rcons, 't) lam -> ('e, 's -> 't) lam - | App : ('e, 's -> 't) lam * ('e, 's) lam -> ('e, 't) lam - -type x = X -type y = Y - -let ex1 = App (Var X, Shift (Var Y)) -let ex2 = Abs (X, Abs (Y, App (Shift (Var X), Var Y))) - -type _ env = - | Enil : rnil env - | Econs : 'a * 't * 'e env -> ('a, 't, 'e) rcons env - -let rec eval_lam : type e t. e env -> (e, t) lam -> t = - fun env m -> - match env, m with - | _, Const n -> n - | Econs (_, v, r), Var _ -> v - | Econs (_, _, r), Shift e -> eval_lam r e - | _, Abs (n, body) -> fun x -> eval_lam (Econs (n, x, env)) body - | _, App (f, x) -> eval_lam env f (eval_lam env x) -;; - -type add = Add -type suc = Suc - -let env0 = Econs (Zero, 0, Econs (Suc, succ, Econs (Add, ( + ), Enil))) -let _0 : (_, int) lam = Var Zero -let suc x = App (Shift (Var Suc : (_, int -> int) lam), x) -let _1 = suc _0 -let _2 = suc _1 -let _3 = suc _2 -let add = Shift (Shift (Var Add : (_, int -> int -> int) lam)) -let double = Abs (X, App (App (Shift add, Var X), Var X)) -let ex3 = App (double, _3) -let v3 = eval_lam env0 ex3 - -(* 5.13: Constructing typing derivations at runtime *) - -(* Modified slightly to use the language of 5.10, since this is more fun. - Of course this works also with the language of 5.12. *) - -type _ rep = - | I : int rep - | Ar : 'a rep * 'b rep -> ('a -> 'b) rep - -let rec compare : type a b. a rep -> b rep -> (string, (a, b) equal) sum = - fun a b -> - match a, b with - | I, I -> Inr Eq - | Ar (x, y), Ar (s, t) -> - (match compare x s with - | Inl _ as e -> e - | Inr Eq -> - (match compare y t with - | Inl _ as e -> e - | Inr Eq as e -> e)) - | I, Ar _ -> Inl "I <> Ar _" - | Ar _, I -> Inl "Ar _ <> I" -;; - -type term = - | C of int - | Ab : string * 'a rep * term -> term - | Ap of term * term - | V of string - -type _ ctx = - | Cnil : rnil ctx - | Ccons : 't * string * 'x rep * 'e ctx -> ('t, 'x, 'e) rcons ctx - -type _ checked = - | Cerror of string - | Cok : ('e, 't) lam * 't rep -> 'e checked - -let rec lookup : type e. string -> e ctx -> e checked = - fun name ctx -> - match ctx with - | Cnil -> Cerror ("Name not found: " ^ name) - | Ccons (l, s, t, rs) -> - if s = name - then Cok (Var l, t) - else ( - match lookup name rs with - | Cerror m -> Cerror m - | Cok (v, t) -> Cok (Shift v, t)) -;; - -let rec tc : type n e. n nat -> e ctx -> term -> e checked = - fun n ctx t -> - match t with - | V s -> lookup s ctx - | Ap (f, x) -> - (match tc n ctx f with - | Cerror _ as e -> e - | Cok (f', ft) -> - (match tc n ctx x with - | Cerror _ as e -> e - | Cok (x', xt) -> - (match ft with - | Ar (a, b) -> - (match compare a xt with - | Inl s -> Cerror s - | Inr Eq -> Cok (App (f', x'), b)) - | _ -> Cerror "Non fun in Ap"))) - | Ab (s, t, body) -> - (match tc (NS n) (Ccons (n, s, t, ctx)) body with - | Cerror _ as e -> e - | Cok (body', et) -> Cok (Abs (n, body'), Ar (t, et))) - | C m -> Cok (Const m, I) -;; - -let ctx0 = - Ccons - (Zero, "0", I, Ccons (Suc, "S", Ar (I, I), Ccons (Add, "+", Ar (I, Ar (I, I)), Cnil))) -;; - -let ex1 = Ab ("x", I, Ap (Ap (V "+", V "x"), V "x")) -let c1 = tc NZ ctx0 ex1 -let ex2 = Ap (ex1, C 3) -let c2 = tc NZ ctx0 ex2 - -let eval_checked env = function - | Cerror s -> failwith s - | Cok (e, I) -> (eval_lam env e : int) - | Cok _ -> failwith "Can only evaluate expressions of type I" -;; - -let v2 = eval_checked env0 c2 - -(* 5.12 Soundness *) - -type pexp = PEXP -type pval = PVAL - -type _ mode = - | Pexp : pexp mode - | Pval : pval mode - -type ('a, 'b) tarr = TARR -type tint = TINT - -type (_, _) rel = - | IntR : (tint, int) rel - | IntTo : ('b, 's) rel -> ((tint, 'b) tarr, int -> 's) rel - -type (_, _, _) lam = - | Const : ('a, 'b) rel * 'b -> (pval, 'env, 'a) lam - | Var : 'a -> (pval, ('a, 't, 'e) rcons, 't) lam - | Shift : ('m, 'e, 't) lam -> ('m, ('a, 'q, 'e) rcons, 't) lam - | Lam : 'a * ('m, ('a, 's, 'e) rcons, 't) lam -> (pval, 'e, ('s, 't) tarr) lam - | App : ('m1, 'e, ('s, 't) tarr) lam * ('m2, 'e, 's) lam -> (pexp, 'e, 't) lam - -let ex1 = App (Lam (X, Var X), Const (IntR, 3)) - -let rec mode : type m e t. (m, e, t) lam -> m mode = function - | Lam (v, body) -> Pval - | Var v -> Pval - | Const (r, v) -> Pval - | Shift e -> mode e - | App _ -> Pexp -;; - -type (_, _) sub = - | Id : ('r, 'r) sub - | Bind : 't * ('m, 'r2, 'x) lam * ('r, 'r2) sub -> (('t, 'x, 'r) rcons, 'r2) sub - | Push : ('r1, 'r2) sub -> (('a, 'b, 'r1) rcons, ('a, 'b, 'r2) rcons) sub - -type (_, _) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam' - -let rec subst : type m1 r t s. (m1, r, t) lam -> (r, s) sub -> (s, t) lam' = - fun t s -> - match t, s with - | _, Id -> Ex t - | Const (r, c), sub -> Ex (Const (r, c)) - | Var v, Bind (x, e, r) -> Ex e - | Var v, Push sub -> Ex (Var v) - | Shift e, Bind (_, _, r) -> subst e r - | Shift e, Push sub -> - (match subst e sub with - | Ex a -> Ex (Shift a)) - | App (f, x), sub -> - (match subst f sub, subst x sub with - | Ex g, Ex y -> Ex (App (g, y))) - | Lam (v, x), sub -> - (match subst x (Push sub) with - | Ex body -> Ex (Lam (v, body))) -;; - -type closed = rnil -type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum - -let rec rule - : type a b. (pval, closed, (a, b) tarr) lam -> (pval, closed, a) lam -> b rlam - = - fun v1 v2 -> - match v1, v2 with - | Lam (x, body), v -> - (match subst body (Bind (x, v, Id)) with - | Ex term -> - (match mode term with - | Pexp -> Inl term - | Pval -> Inr term)) - | Const (IntTo b, f), Const (IntR, x) -> Inr (Const (b, f x)) -;; - -let rec onestep : type m t. (m, closed, t) lam -> t rlam = function - | Lam (v, body) -> Inr (Lam (v, body)) - | Const (r, v) -> Inr (Const (r, v)) - | App (e1, e2) -> - (match mode e1, mode e2 with - | Pexp, _ -> - (match onestep e1 with - | Inl e -> Inl (App (e, e2)) - | Inr v -> Inl (App (v, e2))) - | Pval, Pexp -> - (match onestep e2 with - | Inl e -> Inl (App (e1, e)) - | Inr v -> Inl (App (e1, v))) - | Pval, Pval -> rule e1 e2) -;; - -type ('env, 'a) var = - | Zero : ('a * 'env, 'a) var - | Succ : ('env, 'a) var -> ('b * 'env, 'a) var - -type ('env, 'a) typ = - | Tint : ('env, int) typ - | Tbool : ('env, bool) typ - | Tvar : ('env, 'a) var -> ('env, 'a) typ - -let f : type env a. (env, a) typ -> (env, a) typ -> int = - fun ta tb -> - match ta, tb with - | Tint, Tint -> 0 - | Tbool, Tbool -> 1 - | Tvar var, tb -> 2 - | _ -> . (* error *) -;; - -(* let x = f Tint (Tvar Zero) ;; *) -type inkind = - [ `Link - | `Nonlink - ] - -type _ inline_t = - | Text : string -> [< inkind > `Nonlink ] inline_t - | Bold : 'a inline_t list -> 'a inline_t - | Link : string -> [< inkind > `Link ] inline_t - | Mref : string * [ `Nonlink ] inline_t list -> [< inkind > `Link ] inline_t - -let uppercase seq = - let rec process : type a. a inline_t -> a inline_t = function - | Text txt -> Text (String.uppercase_ascii txt) - | Bold xs -> Bold (List.map process xs) - | Link lnk -> Link lnk - | Mref (lnk, xs) -> Mref (lnk, List.map process xs) - in - List.map process seq -;; - -type ast_t = - | Ast_Text of string - | Ast_Bold of ast_t list - | Ast_Link of string - | Ast_Mref of string * ast_t list - -let inlineseq_from_astseq seq = - let rec process_nonlink = function - | Ast_Text txt -> Text txt - | Ast_Bold xs -> Bold (List.map process_nonlink xs) - | _ -> assert false - in - let rec process_any = function - | Ast_Text txt -> Text txt - | Ast_Bold xs -> Bold (List.map process_any xs) - | Ast_Link lnk -> Link lnk - | Ast_Mref (lnk, xs) -> Mref (lnk, List.map process_nonlink xs) - in - List.map process_any seq -;; - -(* OK *) -type _ linkp = - | Nonlink : [ `Nonlink ] linkp - | Maylink : inkind linkp - -let inlineseq_from_astseq seq = - let rec process : type a. a linkp -> ast_t -> a inline_t = - fun allow_link ast -> - match allow_link, ast with - | Maylink, Ast_Text txt -> Text txt - | Nonlink, Ast_Text txt -> Text txt - | x, Ast_Bold xs -> Bold (List.map (process x) xs) - | Maylink, Ast_Link lnk -> Link lnk - | Nonlink, Ast_Link _ -> assert false - | Maylink, Ast_Mref (lnk, xs) -> Mref (lnk, List.map (process Nonlink) xs) - | Nonlink, Ast_Mref _ -> assert false - in - List.map (process Maylink) seq -;; - -(* Bad *) -type _ linkp2 = Kind : 'a linkp -> ([< inkind ] as 'a) linkp2 - -let inlineseq_from_astseq seq = - let rec process : type a. a linkp2 -> ast_t -> a inline_t = - fun allow_link ast -> - match allow_link, ast with - | Kind _, Ast_Text txt -> Text txt - | x, Ast_Bold xs -> Bold (List.map (process x) xs) - | Kind Maylink, Ast_Link lnk -> Link lnk - | Kind Nonlink, Ast_Link _ -> assert false - | Kind Maylink, Ast_Mref (lnk, xs) -> Mref (lnk, List.map (process (Kind Nonlink)) xs) - | Kind Nonlink, Ast_Mref _ -> assert false - in - List.map (process (Kind Maylink)) seq -;; - -module Add (T : sig - type two - end) = -struct - type _ t = - | One : [ `One ] t - | Two : T.two t - - let add (type a) : a t * a t -> string = function - | One, One -> "two" - | Two, Two -> "four" - ;; -end - -module B : sig - type (_, _) t = Eq : ('a, 'a) t - - val f : 'a -> 'b -> ('a, 'b) t -end = struct - type (_, _) t = Eq : ('a, 'a) t - - let f t1 t2 = Obj.magic Eq -end - -let of_type : type a. a -> a = - fun x -> - match B.f x 4 with - | Eq -> 5 -;; - -type _ constant = - | Int : int -> int constant - | Bool : bool -> bool constant - -type (_, _, _) binop = - | Eq : ('a, 'a, bool) binop - | Leq : ('a, 'a, bool) binop - | Add : (int, int, int) binop - -let eval - (type a) - (type b) - (type c) - (bop : (a, b, c) binop) - (x : a constant) - (y : b constant) - : c constant - = - match bop, x, y with - | Eq, Bool x, Bool y -> Bool (if x then y else not y) - | Leq, Int x, Int y -> Bool (x <= y) - | Leq, Bool x, Bool y -> Bool (x <= y) - | Add, Int x, Int y -> Int (x + y) -;; - -let _ = eval Eq (Int 2) (Int 3) - -type tag = - [ `TagA - | `TagB - | `TagC - ] - -type 'a poly = - | AandBTags : [< `TagA of int | `TagB ] poly - | ATag : [< `TagA of int ] poly - (* constraint 'a = [< `TagA of int | `TagB] *) - -let intA = function - | `TagA i -> i -;; - -let intB = function - | `TagB -> 4 -;; - -let intAorB = function - | `TagA i -> i - | `TagB -> 4 -;; - -type _ wrapPoly = WrapPoly : 'a poly -> ([< `TagA of int | `TagB ] as 'a) wrapPoly - -let example6 : type a. a wrapPoly -> a -> int = - fun w -> - match w with - | WrapPoly ATag -> intA - | WrapPoly _ -> intA (* This should not be allowed *) -;; - -let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *) - -module F (S : sig - type 'a t - end) = -struct - type _ ab = - | A : int S.t ab - | B : float S.t ab - - let f : int S.t ab -> float S.t ab -> string = - fun (l : int S.t ab) (r : float S.t ab) -> - match l, r with - | A, B -> "f A B" - ;; -end - -module F (S : sig - type 'a t - end) = -struct - type a = int * int - type b = int -> int - - type _ ab = - | A : a S.t ab - | B : b S.t ab - - let f : a S.t ab -> b S.t ab -> string = - fun l r -> - match l, r with - | A, B -> "f A B" - ;; -end - -type (_, _) t = - | Any : ('a, 'b) t - | Eq : ('a, 'a) t - -module M : sig - type s = private [> `A ] - - val eq : (s, [ `A | `B ]) t -end = struct - type s = - [ `A - | `B - ] - - let eq = Eq -end - -let f : (M.s, [ `A | `B ]) t -> string = function - | Any -> "Any" -;; - -let () = print_endline (f M.eq) - -module N : sig - type s = private < a : int ; .. > - - val eq : (s, < a : int ; b : bool >) t -end = struct - type s = < a : int ; b : bool > - - let eq = Eq -end - -let f : (N.s, < a : int ; b : bool >) t -> string = function - | Any -> "Any" -;; - -type (_, _) comp = - | Eq : ('a, 'a) comp - | Diff : ('a, 'b) comp - -module U = struct - type t = T -end - -module M : sig - type t = T - - val comp : (U.t, t) comp -end = struct - include U - - let comp = Eq -end -;; - -match M.comp with -| Diff -> false - -module U = struct - type t = { x : int } -end - -module M : sig - type t = { x : int } - - val comp : (U.t, t) comp -end = struct - include U - - let comp = Eq -end -;; - -match M.comp with -| Diff -> false - -type 'a t = T of 'a -type 'a s = S of 'a -type (_, _) eq = Refl : ('a, 'a) eq - -let f : (int s, int t) eq -> unit = function - | Refl -> () -;; - -module M (S : sig - type 'a t = T of 'a - type 'a s = T of 'a - end) = -struct - let f : ('a S.s, 'a S.t) eq -> unit = function - | Refl -> () - ;; -end - -type _ nat = - | Zero : [ `Zero ] nat - | Succ : 'a nat -> [ `Succ of 'a ] nat - -type 'a pre_nat = - [ `Zero - | `Succ of 'a - ] - -type aux = - | Aux : [ `Succ of [< [< [< [ `Zero ] pre_nat ] pre_nat ] pre_nat ] ] nat -> aux - -let f (Aux x) = - match x with - | Succ Zero -> "1" - | Succ (Succ Zero) -> "2" - | Succ (Succ (Succ Zero)) -> "3" - | Succ (Succ (Succ (Succ Zero))) -> "4" - | _ -> . (* error *) -;; - -type _ t = C : ((('a -> 'o) -> 'o) -> ('b -> 'o) -> 'o) t - -let f : type a o. ((a -> o) -> o) t -> (a -> o) -> o = fun C k -> k (fun x -> x) - -type (_, _) t = - | A : ('a, 'a) t - | B : string -> ('a, 'b) t - -module M - (A : sig - module type T - end) - (B : sig - module type T - end) = -struct - let f : ((module A.T), (module B.T)) t -> string = function - | B s -> s - ;; -end - -module A = struct - module type T = sig end -end - -module N = M (A) (A) - -let x = N.f A - -type 'a visit_action -type insert -type 'a local_visit_action - -type ('a, 'result, 'visit_action) context = - | Local : ('a, ('a * insert as 'result), 'a local_visit_action) context - | Global : ('a, 'a, 'a visit_action) context - -let vexpr (type visit_action) : (_, _, visit_action) context -> _ -> visit_action - = function - | Local -> fun _ -> raise Exit - | Global -> fun _ -> raise Exit -;; - -let vexpr (type visit_action) : ('a, 'result, visit_action) context -> 'a -> visit_action - = function - | Local -> fun _ -> raise Exit - | Global -> fun _ -> raise Exit -;; - -let vexpr (type result) (type visit_action) - : (unit, result, visit_action) context -> unit -> visit_action - = function - | Local -> fun _ -> raise Exit - | Global -> fun _ -> raise Exit -;; - -module A = struct - type nil = Cstr -end - -open A - -type _ s = - | Nil : nil s - | Cons : 't s -> ('h -> 't) s - -type ('stack, 'typ) var = - | Head : (('typ -> _) s, 'typ) var - | Tail : ('tail s, 'typ) var -> ((_ -> 'tail) s, 'typ) var - -type _ lst = - | CNil : nil lst - | CCons : 'h * 't lst -> ('h -> 't) lst - -let rec get_var : type stk ret. (stk s, ret) var -> stk lst -> ret = - fun n s -> - match n, s with - | Head, CCons (h, _) -> h - | Tail n', CCons (_, t) -> get_var n' t -;; - -type 'a t = [< `Foo | `Bar ] as 'a -type 'a s = [< `Foo | `Bar | `Baz > `Bar ] as 'a - -type 'a first = First : 'a second -> ('b t as 'a) first -and 'a second = Second : ('b s as 'a) second - -type aux = Aux : 'a t second * ('a -> int) -> aux - -let it : 'a. ([< `Bar | `Foo > `Bar ] as 'a) = `Bar -let g (Aux (Second, f)) = f it - -type (_, _) eqp = - | Y : ('a, 'a) eqp - | N : string -> ('a, 'b) eqp - -let f : ('a list, 'a) eqp -> unit = function - | N s -> print_string s -;; - -module rec A : sig - type t = B.t list -end = struct - type t = B.t list -end - -and B : sig - type t - - val eq : (B.t list, t) eqp -end = struct - type t = A.t - - let eq = Y -end -;; - -f B.eq - -type (_, _) t = - | Nil : ('tl, 'tl) t - | Cons : 'a * ('b, 'tl) t -> ('a * 'b, 'tl) t - -let get1 (Cons (x, _) : (_ * 'a, 'a) t) = x - -(* warn, cf PR#6993 *) - -let get1' = function - | (Cons (x, _) : (_ * 'a, 'a) t) -> x - | Nil -> assert false -;; - -(* ok *) -type _ t = - | Int : int -> int t - | String : string -> string t - | Same : 'l t -> 'l t - -let rec f = function - | Int x -> x - | Same s -> f s -;; - -type 'a tt = 'a t = - | Int : int -> int tt - | String : string -> string tt - | Same : 'l1 t -> 'l2 tt - -type _ t = I : int t - -let f (type a) (x : a t) = - let module M = struct - let (I : a t) = x (* fail because of toplevel let *) - let x = (I : a t) - end - in - () -;; - -(* extra example by Stephen Dolan, using recursive modules *) -(* Should not be allowed! *) -type (_, _) eq = Refl : ('a, 'a) eq - -let bad (type a) = - let module N = struct - module rec M : sig - val e : (int, a) eq - end = struct - let (Refl : (int, a) eq) = M.e (* must fail for soundness *) - let e : (int, a) eq = Refl - end - end - in - N.M.e -;; - -type +'a n = private int -type nil = private Nil_type - -type (_, _) elt = - | Elt_fine : 'nat n -> ('l, 'nat * 'l) elt - | Elt : 'nat n -> ('l, 'nat -> 'l) elt - -type _ t = - | Nil : nil t - | Cons : ('x, 'fx) elt * 'x t -> 'fx t - -let undetected : ('a -> 'b -> nil) t -> 'a n -> 'b n -> unit = - fun sh i j -> - let (Cons (Elt dim, _)) = sh in - () -;; - -type _ t = T : int t - -(* Should raise Not_found *) -let _ = - match (raise Not_found : float t) with - | _ -> . -;; - -type (_, _) eq = - | Eq : ('a, 'a) eq - | Neq : int -> ('a, 'b) eq - -type 'a t - -let f (type a) (Neq n : (a, a t) eq) = n - -(* warn! *) - -module F (T : sig - type _ t - end) = -struct - let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *) -end - -(* First-Order Unification by Structural Recursion *) -(* Conor McBride, JFP 13(6) *) -(* http://strictlypositive.org/publications.html *) - -(* This is a translation of the code part to ocaml *) -(* Of course, we do not prove other properties, not even termination *) - -(* 2.2 Inductive Families *) - -type zero = Zero -type _ succ = Succ - -type _ nat = - | NZ : zero nat - | NS : 'a nat -> 'a succ nat - -type _ fin = - | FZ : 'a succ fin - | FS : 'a fin -> 'a succ fin - -(* We cannot define - val empty : zero fin -> 'a - because we cannot write an empty pattern matching. - This might be useful to have *) - -(* In place, prove that the parameter is 'a succ *) -type _ is_succ = IS : 'a succ is_succ - -let fin_succ : type n. n fin -> n is_succ = function - | FZ -> IS - | FS _ -> IS -;; - -(* 3 First-Order Terms, Renaming and Substitution *) - -type 'a term = - | Var of 'a fin - | Leaf - | Fork of 'a term * 'a term - -let var x = Var x -let lift r : 'm fin -> 'n term = fun x -> Var (r x) - -let rec pre_subst f = function - | Var x -> f x - | Leaf -> Leaf - | Fork (t1, t2) -> Fork (pre_subst f t1, pre_subst f t2) -;; - -let comp_subst f g (x : 'a fin) = pre_subst f (g x) -(* val comp_subst : - ('b fin -> 'c term) -> ('a fin -> 'b term) -> 'a fin -> 'c term *) - -(* 4 The Occur-Check, through thick and thin *) - -let rec thin : type n. n succ fin -> n fin -> n succ fin = - fun x y -> - match x, y with - | FZ, y -> FS y - | FS x, FZ -> FZ - | FS x, FS y -> FS (thin x y) -;; - -let bind t f = - match t with - | None -> None - | Some x -> f x -;; - -(* val bind : 'a option -> ('a -> 'b option) -> 'b option *) - -let rec thick : type n. n succ fin -> n succ fin -> n fin option = - fun x y -> - match x, y with - | FZ, FZ -> None - | FZ, FS y -> Some y - | FS x, FZ -> - let IS = fin_succ x in - Some FZ - | FS x, FS y -> - let IS = fin_succ x in - bind (thick x y) (fun x -> Some (FS x)) -;; - -let rec check : type n. n succ fin -> n succ term -> n term option = - fun x t -> - match t with - | Var y -> bind (thick x y) (fun x -> Some (Var x)) - | Leaf -> Some Leaf - | Fork (t1, t2) -> - bind (check x t1) (fun t1 -> bind (check x t2) (fun t2 -> Some (Fork (t1, t2)))) -;; - -let subst_var x t' y = - match thick x y with - | None -> t' - | Some y' -> Var y' -;; - -(* val subst_var : 'a succ fin -> 'a term -> 'a succ fin -> 'a term *) - -let subst x t' = pre_subst (subst_var x t') -(* val subst : 'a succ fin -> 'a term -> 'a succ term -> 'a term *) - -(* 5 A Refinement of Substitution *) - -type (_, _) alist = - | Anil : ('n, 'n) alist - | Asnoc : ('m, 'n) alist * 'm term * 'm succ fin -> ('m succ, 'n) alist - -let rec sub : type m n. (m, n) alist -> m fin -> n term = function - | Anil -> var - | Asnoc (s, t, x) -> comp_subst (sub s) (subst_var x t) -;; - -let rec append : type m n l. (m, n) alist -> (l, m) alist -> (l, n) alist = - fun r s -> - match s with - | Anil -> r - | Asnoc (s, t, x) -> Asnoc (append r s, t, x) -;; - -type _ ealist = EAlist : ('a, 'b) alist -> 'a ealist - -let asnoc a t' x = EAlist (Asnoc (a, t', x)) - -(* Extra work: we need sub to work on ealist too, for examples *) -let rec weaken_fin : type n. n fin -> n succ fin = function - | FZ -> FZ - | FS x -> FS (weaken_fin x) -;; - -let weaken_term t = pre_subst (fun x -> Var (weaken_fin x)) t - -let rec weaken_alist : type m n. (m, n) alist -> (m succ, n succ) alist = function - | Anil -> Anil - | Asnoc (s, t, x) -> Asnoc (weaken_alist s, weaken_term t, weaken_fin x) -;; - -let rec sub' : type m. m ealist -> m fin -> m term = function - | EAlist Anil -> var - | EAlist (Asnoc (s, t, x)) -> - comp_subst (sub' (EAlist (weaken_alist s))) (fun t' -> weaken_term (subst_var x t t')) -;; - -let subst' d = pre_subst (sub' d) -(* val subst' : 'a ealist -> 'a term -> 'a term *) - -(* 6 First-Order Unification *) - -let flex_flex x y = - match thick x y with - | Some y' -> asnoc Anil (Var y') x - | None -> EAlist Anil -;; - -(* val flex_flex : 'a succ fin -> 'a succ fin -> 'a succ ealist *) - -let flex_rigid x t = bind (check x t) (fun t' -> Some (asnoc Anil t' x)) -(* val flex_rigid : 'a succ fin -> 'a succ term -> 'a succ ealist option *) - -let rec amgu : type m. m term -> m term -> m ealist -> m ealist option = - fun s t acc -> - match s, t, acc with - | Leaf, Leaf, _ -> Some acc - | Leaf, Fork _, _ -> None - | Fork _, Leaf, _ -> None - | Fork (s1, s2), Fork (t1, t2), _ -> bind (amgu s1 t1 acc) (amgu s2 t2) - | Var x, Var y, EAlist Anil -> - let IS = fin_succ x in - Some (flex_flex x y) - | Var x, t, EAlist Anil -> - let IS = fin_succ x in - flex_rigid x t - | t, Var x, EAlist Anil -> - let IS = fin_succ x in - flex_rigid x t - | s, t, EAlist (Asnoc (d, r, z)) -> - bind - (amgu (subst z r s) (subst z r t) (EAlist d)) - (fun (EAlist d) -> Some (asnoc d r z)) -;; - -let mgu s t = amgu s t (EAlist Anil) -(* val mgu : 'a term -> 'a term -> 'a ealist option *) - -let s = Fork (Var FZ, Fork (Var (FS (FS FZ)), Leaf)) -let t = Fork (Var (FS FZ), Var (FS FZ)) - -let d = - match mgu s t with - | Some x -> x - | None -> failwith "mgu" -;; - -let s' = subst' d s -let t' = subst' d t - -(* Injectivity *) - -type (_, _) eq = Refl : ('a, 'a) eq - -let magic : 'a 'b. 'a -> 'b = - fun (type a b) (x : a) -> - let module M = - (functor - (T : sig - type 'a t - end) - -> - struct - let f (Refl : (a T.t, b T.t) eq) = (x :> b) - end) - (struct - type 'a t = unit - end) - in - M.f Refl -;; - -(* Variance and subtyping *) - -type (_, +_) eq = Refl : ('a, 'a) eq - -let magic : 'a 'b. 'a -> 'b = - fun (type a) (type b) (x : a) -> - let bad_proof (type a) = (Refl : (< m : a >, < m : a >) eq :> (< m : a >, < >) eq) in - let downcast : type a. (a, < >) eq -> < > -> a = - fun (type a) (Refl : (a, < >) eq) (s : < >) -> (s :> a) - in - (downcast - bad_proof - (object - method m = x - end - :> < >)) - #m -;; - -(* Record patterns *) - -type _ t = - | IntLit : int t - | BoolLit : bool t - -let check : type s. s t * s -> bool = function - | BoolLit, false -> false - | IntLit, 6 -> false -;; - -type ('a, 'b) pair = - { fst : 'a - ; snd : 'b - } - -let check : type s. (s t, s) pair -> bool = function - | { fst = BoolLit; snd = false } -> false - | { fst = IntLit; snd = 6 } -> false -;; - -module type S = sig - type t [@@immediate] -end - -module F (M : S) : S = M - -[%%expect - {| -module type S = sig type t [@@immediate] end -module F : functor (M : S) -> S -|}] - -(* VALID DECLARATIONS *) - -module A = struct - (* Abstract types can be immediate *) - type t [@@immediate] - - (* [@@immediate] tag here is unnecessary but valid since t has it *) - type s = t [@@immediate] - - (* Again, valid alias even without tag *) - type r = s - - (* Mutually recursive declarations work as well *) - type p = q [@@immediate] - and q = int -end - -[%%expect - {| -module A : - sig - type t [@@immediate] - type s = t [@@immediate] - type r = s - type p = q [@@immediate] - and q = int - end -|}] - -(* Valid using with constraints *) -module type X = sig - type t -end - -module Y = struct - type t = int -end - -module Z : sig - type t [@@immediate] -end = (Y : X with type t = int) - -[%%expect - {| -module type X = sig type t end -module Y : sig type t = int end -module Z : sig type t [@@immediate] end -|}] - -(* Valid using an explicit signature *) -module M_valid : S = struct - type t = int -end - -module FM_valid = F (struct - type t = int - end) - -[%%expect - {| -module M_valid : S -module FM_valid : S -|}] - -(* Practical usage over modules *) -module Foo : sig - type t - - val x : t ref -end = struct - type t = int - - let x = ref 0 -end - -[%%expect - {| -module Foo : sig type t val x : t ref end -|}] - -module Bar : sig - type t [@@immediate] - - val x : t ref -end = struct - type t = int - - let x = ref 0 -end - -[%%expect - {| -module Bar : sig type t [@@immediate] val x : t ref end -|}] - -let test f = - let start = Sys.time () in - f (); - Sys.time () -. start -;; - -[%%expect - {| -val test : (unit -> 'a) -> float = <fun> -|}] - -let test_foo () = - for i = 0 to 100_000_000 do - Foo.x := !Foo.x - done -;; - -[%%expect - {| -val test_foo : unit -> unit = <fun> -|}] - -let test_bar () = - for i = 0 to 100_000_000 do - Bar.x := !Bar.x - done -;; - -[%%expect - {| -val test_bar : unit -> unit = <fun> -|}] - -(* Uncomment these to test. Should see substantial speedup! - let () = Printf.printf "No @@immediate: %fs\n" (test test_foo) - let () = Printf.printf "With @@immediate: %fs\n" (test test_bar) *) - -(* INVALID DECLARATIONS *) - -(* Cannot directly declare a non-immediate type as immediate *) -module B = struct - type t = string [@@immediate] -end - -[%%expect - {| -Line _, characters 2-31: -Error: Types marked with the immediate attribute must be - non-pointer types like int or bool -|}] - -(* Not guaranteed that t is immediate, so this is an invalid declaration *) -module C = struct - type t - type s = t [@@immediate] -end - -[%%expect - {| -Line _, characters 2-26: -Error: Types marked with the immediate attribute must be - non-pointer types like int or bool -|}] - -(* Can't ascribe to an immediate type signature with a non-immediate type *) -module D : sig - type t [@@immediate] -end = struct - type t = string -end - -[%%expect - {| -Line _, characters 42-70: -Error: Signature mismatch: - Modules do not match: - sig type t = string end - is not included in - sig type t [@@immediate] end - Type declarations do not match: - type t = string - is not included in - type t [@@immediate] - the first is not an immediate type. -|}] - -(* Same as above but with explicit signature *) -module M_invalid : S = struct - type t = string -end - -module FM_invalid = F (struct - type t = string - end) - -[%%expect - {| -Line _, characters 23-49: -Error: Signature mismatch: - Modules do not match: sig type t = string end is not included in S - Type declarations do not match: - type t = string - is not included in - type t [@@immediate] - the first is not an immediate type. -|}] - -(* Can't use a non-immediate type even if mutually recursive *) -module E = struct - type t = s [@@immediate] - and s = string -end - -[%%expect - {| -Line _, characters 2-26: -Error: Types marked with the immediate attribute must be - non-pointer types like int or bool -|}] - -(* - Implicit unpack allows to omit the signature in (val ...) expressions. - - It also adds (module M : S) and (module M) patterns, relying on - implicit (val ...) for the implementation. Such patterns can only - be used in function definition, match clauses, and let ... in. - - New: implicit pack is also supported, and you only need to be able - to infer the the module type path from the context. -*) -(* ocaml -principal *) - -(* Use a module pattern *) -let sort (type s) (module Set : Set.S with type elt = s) l = - Set.elements (List.fold_right Set.add l Set.empty) -;; - -(* No real improvement here? *) -let make_set (type s) cmp : (module Set.S with type elt = s) = - (module Set.Make (struct - type t = s - - let compare = cmp - end)) -;; - -(* No type annotation here *) -let sort_cmp (type s) cmp = - sort - (module Set.Make (struct - type t = s - - let compare = cmp - end)) -;; - -module type S = sig - type t - - val x : t -end - -let f (module M : S with type t = int) = M.x -let f (module M : S with type t = 'a) = M.x - -(* Error *) -let f (type a) (module M : S with type t = a) = M.x;; - -f - (module struct - type t = int - - let x = 1 - end) - -type 'a s = { s : (module S with type t = 'a) };; - -{ s = - (module struct - type t = int - - let x = 1 - end) -} - -let f { s = (module M) } = M.x - -(* Error *) -let f (type a) ({ s = (module M) } : a s) = M.x - -type s = { s : (module S with type t = int) } - -let f { s = (module M) } = M.x -let f { s = (module M) } { s = (module N) } = M.x + N.x - -module type S = sig - val x : int -end - -let f (module M : S) y (module N : S) = M.x + y + N.x - -let m = - (module struct - let x = 3 - end) -;; - -(* Error *) -let m = - (module struct - let x = 3 - end : S) -;; - -f m 1 m;; - -f - m - 1 - (module struct - let x = 2 - end) -;; - -let (module M) = m in -M.x - -let (module M) = m - -(* Error: only allowed in [let .. in] *) -class c = - let (module M) = m in - object end - -(* Error again *) -module M = (val m) - -module type S' = sig - val f : int -> int -end -;; - -(* Even works with recursion, but must be fully explicit *) -let rec (module M : S') = - (module struct - let f n = if n <= 0 then 1 else n * M.f (n - 1) - end : S') -in -M.f 3 - -(* Subtyping *) - -module type S = sig - type t - type u - - val x : t * u -end - -let f (l : (module S with type t = int and type u = bool) list) = - (l :> (module S with type u = bool) list) -;; - -(* GADTs from the manual *) -(* the only modification is in to_string *) - -module TypEq : sig - type ('a, 'b) t - - val apply : ('a, 'b) t -> 'a -> 'b - val refl : ('a, 'a) t - val sym : ('a, 'b) t -> ('b, 'a) t -end = struct - type ('a, 'b) t = ('a -> 'b) * ('b -> 'a) - - let refl = (fun x -> x), fun x -> x - let apply (f, _) x = f x - let sym (f, g) = g, f -end - -module rec Typ : sig - module type PAIR = sig - type t - and t1 - and t2 - - val eq : (t, t1 * t2) TypEq.t - val t1 : t1 Typ.typ - val t2 : t2 Typ.typ - end - - type 'a typ = - | Int of ('a, int) TypEq.t - | String of ('a, string) TypEq.t - | Pair of (module PAIR with type t = 'a) -end = - Typ - -let int = Typ.Int TypEq.refl -let str = Typ.String TypEq.refl - -let pair (type s1) (type s2) t1 t2 = - let module P = struct - type t = s1 * s2 - type t1 = s1 - type t2 = s2 - - let eq = TypEq.refl - let t1 = t1 - let t2 = t2 - end - in - Typ.Pair (module P) -;; - -open Typ - -let rec to_string : 'a. 'a Typ.typ -> 'a -> string = - fun (type s) t x -> - match (t : s typ) with - | Int eq -> string_of_int (TypEq.apply eq x) - | String eq -> Printf.sprintf "%S" (TypEq.apply eq x) - | Pair (module P) -> - let x1, x2 = TypEq.apply P.eq x in - Printf.sprintf "(%s,%s)" (to_string P.t1 x1) (to_string P.t2 x2) -;; - -(* Wrapping maps *) -module type MapT = sig - include Map.S - - type data - type map - - val of_t : data t -> map - val to_t : map -> data t -end - -type ('k, 'd, 'm) map = - (module MapT with type key = 'k and type data = 'd and type map = 'm) - -let add (type k) (type d) (type m) (m : (k, d, m) map) x y s = - let module M = (val m : MapT with type key = k and type data = d and type map = m) in - M.of_t (M.add x y (M.to_t s)) -;; - -module SSMap = struct - include Map.Make (String) - - type data = string - type map = data t - - let of_t x = x - let to_t x = x -end - -let ssmap = - (module SSMap : MapT - with type key = string - and type data = string - and type map = SSMap.map) -;; - -let ssmap = - (module struct - include SSMap - end : MapT - with type key = string - and type data = string - and type map = SSMap.map) -;; - -let ssmap = - (let module S = struct - include SSMap - end - in - (module S) - : (module MapT with type key = string and type data = string and type map = SSMap.map)) -;; - -let ssmap = (module SSMap : MapT with type key = _ and type data = _ and type map = _) -let ssmap : (_, _, _) map = (module SSMap);; - -add ssmap - -open StdLabels -open MoreLabels - -(* Use maps for substitutions and sets for free variables *) - -module Subst = Map.Make (struct - type t = string - - let compare = compare - end) - -module Names = Set.Make (struct - type t = string - - let compare = compare - end) - -(* Variables are common to lambda and expr *) - -type var = [ `Var of string ] - -let subst_var ~subst : var -> _ = function - | `Var s as x -> - (try Subst.find s subst with - | Not_found -> x) -;; - -let free_var : var -> _ = function - | `Var s -> Names.singleton s -;; - -(* The lambda language: free variables, substitutions, and evaluation *) - -type 'a lambda = - [ `Var of string - | `Abs of string * 'a - | `App of 'a * 'a - ] - -let free_lambda ~free_rec : _ lambda -> _ = function - | #var as x -> free_var x - | `Abs (s, t) -> Names.remove s (free_rec t) - | `App (t1, t2) -> Names.union (free_rec t1) (free_rec t2) -;; - -let map_lambda ~map_rec : _ lambda -> _ = function - | #var as x -> x - | `Abs (s, t) as l -> - let t' = map_rec t in - if t == t' then l else `Abs (s, t') - | `App (t1, t2) as l -> - let t'1 = map_rec t1 - and t'2 = map_rec t2 in - if t'1 == t1 && t'2 == t2 then l else `App (t'1, t'2) -;; - -let next_id = - let current = ref 3 in - fun () -> - incr current; - !current -;; - -let subst_lambda ~subst_rec ~free ~subst : _ lambda -> _ = function - | #var as x -> subst_var ~subst x - | `Abs (s, t) as l -> - let used = free t in - let used_expr = - Subst.fold subst ~init:[] ~f:(fun ~key ~data acc -> - if Names.mem s used then data :: acc else acc) - in - if List.exists used_expr ~f:(fun t -> Names.mem s (free t)) - then ( - let name = s ^ string_of_int (next_id ()) in - `Abs (name, subst_rec ~subst:(Subst.add ~key:s ~data:(`Var name) subst) t)) - else map_lambda ~map_rec:(subst_rec ~subst:(Subst.remove s subst)) l - | `App _ as l -> map_lambda ~map_rec:(subst_rec ~subst) l -;; - -let eval_lambda ~eval_rec ~subst l = - match map_lambda ~map_rec:eval_rec l with - | `App (`Abs (s, t1), t2) -> - eval_rec (subst ~subst:(Subst.add ~key:s ~data:t2 Subst.empty) t1) - | t -> t -;; - -(* Specialized versions to use on lambda *) - -let rec free1 x = free_lambda ~free_rec:free1 x -let rec subst1 ~subst = subst_lambda ~subst_rec:subst1 ~free:free1 ~subst -let rec eval1 x = eval_lambda ~eval_rec:eval1 ~subst:subst1 x - -(* The expr language of arithmetic expressions *) - -type 'a expr = - [ `Var of string - | `Num of int - | `Add of 'a * 'a - | `Neg of 'a - | `Mult of 'a * 'a - ] - -let free_expr ~free_rec : _ expr -> _ = function - | #var as x -> free_var x - | `Num _ -> Names.empty - | `Add (x, y) -> Names.union (free_rec x) (free_rec y) - | `Neg x -> free_rec x - | `Mult (x, y) -> Names.union (free_rec x) (free_rec y) -;; - -(* Here map_expr helps a lot *) -let map_expr ~map_rec : _ expr -> _ = function - | #var as x -> x - | `Num _ as x -> x - | `Add (x, y) as e -> - let x' = map_rec x - and y' = map_rec y in - if x == x' && y == y' then e else `Add (x', y') - | `Neg x as e -> - let x' = map_rec x in - if x == x' then e else `Neg x' - | `Mult (x, y) as e -> - let x' = map_rec x - and y' = map_rec y in - if x == x' && y == y' then e else `Mult (x', y') -;; - -let subst_expr ~subst_rec ~subst : _ expr -> _ = function - | #var as x -> subst_var ~subst x - | #expr as e -> map_expr ~map_rec:(subst_rec ~subst) e -;; - -let eval_expr ~eval_rec e = - match map_expr ~map_rec:eval_rec e with - | `Add (`Num m, `Num n) -> `Num (m + n) - | `Neg (`Num n) -> `Num (-n) - | `Mult (`Num m, `Num n) -> `Num (m * n) - | #expr as e -> e -;; - -(* Specialized versions *) - -let rec free2 x = free_expr ~free_rec:free2 x -let rec subst2 ~subst = subst_expr ~subst_rec:subst2 ~subst -let rec eval2 x = eval_expr ~eval_rec:eval2 x - -(* The lexpr language, reunion of lambda and expr *) - -type lexpr = - [ `Var of string - | `Abs of string * lexpr - | `App of lexpr * lexpr - | `Num of int - | `Add of lexpr * lexpr - | `Neg of lexpr - | `Mult of lexpr * lexpr - ] - -let rec free : lexpr -> _ = function - | #lambda as x -> free_lambda ~free_rec:free x - | #expr as x -> free_expr ~free_rec:free x -;; - -let rec subst ~subst:s : lexpr -> _ = function - | #lambda as x -> subst_lambda ~subst_rec:subst ~subst:s ~free x - | #expr as x -> subst_expr ~subst_rec:subst ~subst:s x -;; - -let rec eval : lexpr -> _ = function - | #lambda as x -> eval_lambda ~eval_rec:eval ~subst x - | #expr as x -> eval_expr ~eval_rec:eval x -;; - -let rec print = function - | `Var id -> print_string id - | `Abs (id, l) -> - print_string (" " ^ id ^ " . "); - print l - | `App (l1, l2) -> - print l1; - print_string " "; - print l2 - | `Num x -> print_int x - | `Add (e1, e2) -> - print e1; - print_string " + "; - print e2 - | `Neg e -> - print_string "-"; - print e - | `Mult (e1, e2) -> - print e1; - print_string " * "; - print e2 -;; - -let () = - let e1 = eval1 (`App (`Abs ("x", `Var "x"), `Var "y")) in - let e2 = eval2 (`Add (`Mult (`Num 3, `Neg (`Num 2)), `Var "x")) in - let e3 = eval (`Add (`App (`Abs ("x", `Mult (`Var "x", `Var "x")), `Num 2), `Num 5)) in - print e1; - print_newline (); - print e2; - print_newline (); - print e3; - print_newline () -;; - -(* Full fledge version, using objects to structure code *) - -open StdLabels -open MoreLabels - -(* Use maps for substitutions and sets for free variables *) - -module Subst = Map.Make (struct - type t = string - - let compare = compare - end) - -module Names = Set.Make (struct - type t = string - - let compare = compare - end) - -(* To build recursive objects *) - -let lazy_fix make = - let rec obj () = make (lazy (obj ()) : _ Lazy.t) in - obj () -;; - -let ( !! ) = Lazy.force - -(* The basic operations *) - -class type ['a, 'b] ops = object - method free : x:'b -> ?y:'c -> Names.t - method subst : sub:'a Subst.t -> 'b -> 'a - method eval : 'b -> 'a -end - -(* Variables are common to lambda and expr *) - -type var = [ `Var of string ] - -class ['a] var_ops = - object (self : ('a, var) #ops) - constraint 'a = [> var ] - - method subst ~sub (`Var s as x) = - try Subst.find s sub with - | Not_found -> x - - method free (`Var s) = Names.singleton s - method eval (#var as v) = v - end - -(* The lambda language: free variables, substitutions, and evaluation *) - -type 'a lambda = - [ `Var of string - | `Abs of string * 'a - | `App of 'a * 'a - ] - -let next_id = - let current = ref 3 in - fun () -> - incr current; - !current -;; - -class ['a] lambda_ops (ops : ('a, 'a) #ops Lazy.t) = - let var : 'a var_ops = new var_ops - and free = lazy !!ops#free - and subst = lazy !!ops#subst - and eval = lazy !!ops#eval in - object (self : ('a, 'a lambda) #ops) - constraint 'a = [> 'a lambda ] - - method free = - function - | #var as x -> var#free x - | `Abs (s, t) -> Names.remove s (!!free t) - | `App (t1, t2) -> Names.union (!!free t1) (!!free t2) - - method map ~f = - function - | #var as x -> x - | `Abs (s, t) as l -> - let t' = f t in - if t == t' then l else `Abs (s, t') - | `App (t1, t2) as l -> - let t'1 = f t1 - and t'2 = f t2 in - if t'1 == t1 && t'2 == t2 then l else `App (t'1, t'2) - - method subst ~sub = - function - | #var as x -> var#subst ~sub x - | `Abs (s, t) as l -> - let used = !!free t in - let used_expr = - Subst.fold sub ~init:[] ~f:(fun ~key ~data acc -> - if Names.mem s used then data :: acc else acc) - in - if List.exists used_expr ~f:(fun t -> Names.mem s (!!free t)) - then ( - let name = s ^ string_of_int (next_id ()) in - `Abs (name, !!subst ~sub:(Subst.add ~key:s ~data:(`Var name) sub) t)) - else self#map ~f:(!!subst ~sub:(Subst.remove s sub)) l - | `App _ as l -> self#map ~f:(!!subst ~sub) l - - method eval l = - match self#map ~f:!!eval l with - | `App (`Abs (s, t1), t2) -> - !!eval (!!subst ~sub:(Subst.add ~key:s ~data:t2 Subst.empty) t1) - | t -> t - end - -(* Operations specialized to lambda *) - -let lambda = lazy_fix (new lambda_ops) - -(* The expr language of arithmetic expressions *) - -type 'a expr = - [ `Var of string - | `Num of int - | `Add of 'a * 'a - | `Neg of 'a - | `Mult of 'a * 'a - ] - -class ['a] expr_ops (ops : ('a, 'a) #ops Lazy.t) = - let var : 'a var_ops = new var_ops - and free = lazy !!ops#free - and subst = lazy !!ops#subst - and eval = lazy !!ops#eval in - object (self : ('a, 'a expr) #ops) - constraint 'a = [> 'a expr ] - - method free = - function - | #var as x -> var#free x - | `Num _ -> Names.empty - | `Add (x, y) -> Names.union (!!free x) (!!free y) - | `Neg x -> !!free x - | `Mult (x, y) -> Names.union (!!free x) (!!free y) - - method map ~f = - function - | #var as x -> x - | `Num _ as x -> x - | `Add (x, y) as e -> - let x' = f x - and y' = f y in - if x == x' && y == y' then e else `Add (x', y') - | `Neg x as e -> - let x' = f x in - if x == x' then e else `Neg x' - | `Mult (x, y) as e -> - let x' = f x - and y' = f y in - if x == x' && y == y' then e else `Mult (x', y') - - method subst ~sub = - function - | #var as x -> var#subst ~sub x - | #expr as e -> self#map ~f:(!!subst ~sub) e - - method eval (#expr as e) = - match self#map ~f:!!eval e with - | `Add (`Num m, `Num n) -> `Num (m + n) - | `Neg (`Num n) -> `Num (-n) - | `Mult (`Num m, `Num n) -> `Num (m * n) - | e -> e - end - -(* Specialized versions *) - -let expr = lazy_fix (new expr_ops) - -(* The lexpr language, reunion of lambda and expr *) - -type 'a lexpr = - [ 'a lambda - | 'a expr - ] - -class ['a] lexpr_ops (ops : ('a, 'a) #ops Lazy.t) = - let lambda = new lambda_ops ops in - let expr = new expr_ops ops in - object (self : ('a, 'a lexpr) #ops) - constraint 'a = [> 'a lexpr ] - - method free = - function - | #lambda as x -> lambda#free x - | #expr as x -> expr#free x - - method subst ~sub = - function - | #lambda as x -> lambda#subst ~sub x - | #expr as x -> expr#subst ~sub x - - method eval = - function - | #lambda as x -> lambda#eval x - | #expr as x -> expr#eval x - end - -let lexpr = lazy_fix (new lexpr_ops) - -let rec print = function - | `Var id -> print_string id - | `Abs (id, l) -> - print_string (" " ^ id ^ " . "); - print l - | `App (l1, l2) -> - print l1; - print_string " "; - print l2 - | `Num x -> print_int x - | `Add (e1, e2) -> - print e1; - print_string " + "; - print e2 - | `Neg e -> - print_string "-"; - print e - | `Mult (e1, e2) -> - print e1; - print_string " * "; - print e2 -;; - -let () = - let e1 = lambda#eval (`App (`Abs ("x", `Var "x"), `Var "y")) in - let e2 = expr#eval (`Add (`Mult (`Num 3, `Neg (`Num 2)), `Var "x")) in - let e3 = - lexpr#eval (`Add (`App (`Abs ("x", `Mult (`Var "x", `Var "x")), `Num 2), `Num 5)) - in - print e1; - print_newline (); - print e2; - print_newline (); - print e3; - print_newline () -;; - -(* Full fledge version, using objects to structure code *) - -open StdLabels -open MoreLabels - -(* Use maps for substitutions and sets for free variables *) - -module Subst = Map.Make (struct - type t = string - - let compare = compare - end) - -module Names = Set.Make (struct - type t = string - - let compare = compare - end) - -(* To build recursive objects *) - -let lazy_fix make = - let rec obj () = make (lazy (obj ()) : _ Lazy.t) in - obj () -;; - -let ( !! ) = Lazy.force - -(* The basic operations *) - -class type ['a, 'b] ops = object - method free : 'b -> Names.t - method subst : sub:'a Subst.t -> 'b -> 'a - method eval : 'b -> 'a -end - -(* Variables are common to lambda and expr *) - -type var = [ `Var of string ] - -let var = - object (self : ([> var ], var) #ops) - method subst ~sub (`Var s as x) = - try Subst.find s sub with - | Not_found -> x - - method free (`Var s) = Names.singleton s - method eval (#var as v) = v - end -;; - -(* The lambda language: free variables, substitutions, and evaluation *) - -type 'a lambda = - [ `Var of string - | `Abs of string * 'a - | `App of 'a * 'a - ] - -let next_id = - let current = ref 3 in - fun () -> - incr current; - !current -;; - -let lambda_ops (ops : ('a, 'a) #ops Lazy.t) = - let free = lazy !!ops#free - and subst = lazy !!ops#subst - and eval = lazy !!ops#eval in - object (self : ([> 'a lambda ], 'a lambda) #ops) - method free = - function - | #var as x -> var#free x - | `Abs (s, t) -> Names.remove s (!!free t) - | `App (t1, t2) -> Names.union (!!free t1) (!!free t2) - - method private map ~f = - function - | #var as x -> x - | `Abs (s, t) as l -> - let t' = f t in - if t == t' then l else `Abs (s, t') - | `App (t1, t2) as l -> - let t'1 = f t1 - and t'2 = f t2 in - if t'1 == t1 && t'2 == t2 then l else `App (t'1, t'2) - - method subst ~sub = - function - | #var as x -> var#subst ~sub x - | `Abs (s, t) as l -> - let used = !!free t in - let used_expr = - Subst.fold sub ~init:[] ~f:(fun ~key ~data acc -> - if Names.mem s used then data :: acc else acc) - in - if List.exists used_expr ~f:(fun t -> Names.mem s (!!free t)) - then ( - let name = s ^ string_of_int (next_id ()) in - `Abs (name, !!subst ~sub:(Subst.add ~key:s ~data:(`Var name) sub) t)) - else self#map ~f:(!!subst ~sub:(Subst.remove s sub)) l - | `App _ as l -> self#map ~f:(!!subst ~sub) l - - method eval l = - match self#map ~f:!!eval l with - | `App (`Abs (s, t1), t2) -> - !!eval (!!subst ~sub:(Subst.add ~key:s ~data:t2 Subst.empty) t1) - | t -> t - end -;; - -(* Operations specialized to lambda *) - -let lambda = lazy_fix lambda_ops - -(* The expr language of arithmetic expressions *) - -type 'a expr = - [ `Var of string - | `Num of int - | `Add of 'a * 'a - | `Neg of 'a - | `Mult of 'a * 'a - ] - -let expr_ops (ops : ('a, 'a) #ops Lazy.t) = - let free = lazy !!ops#free - and subst = lazy !!ops#subst - and eval = lazy !!ops#eval in - object (self : ([> 'a expr ], 'a expr) #ops) - method free = - function - | #var as x -> var#free x - | `Num _ -> Names.empty - | `Add (x, y) -> Names.union (!!free x) (!!free y) - | `Neg x -> !!free x - | `Mult (x, y) -> Names.union (!!free x) (!!free y) - - method private map ~f = - function - | #var as x -> x - | `Num _ as x -> x - | `Add (x, y) as e -> - let x' = f x - and y' = f y in - if x == x' && y == y' then e else `Add (x', y') - | `Neg x as e -> - let x' = f x in - if x == x' then e else `Neg x' - | `Mult (x, y) as e -> - let x' = f x - and y' = f y in - if x == x' && y == y' then e else `Mult (x', y') - - method subst ~sub = - function - | #var as x -> var#subst ~sub x - | #expr as e -> self#map ~f:(!!subst ~sub) e - - method eval (#expr as e) = - match self#map ~f:!!eval e with - | `Add (`Num m, `Num n) -> `Num (m + n) - | `Neg (`Num n) -> `Num (-n) - | `Mult (`Num m, `Num n) -> `Num (m * n) - | e -> e - end -;; - -(* Specialized versions *) - -let expr = lazy_fix expr_ops - -(* The lexpr language, reunion of lambda and expr *) - -type 'a lexpr = - [ 'a lambda - | 'a expr - ] - -let lexpr_ops (ops : ('a, 'a) #ops Lazy.t) = - let lambda = lambda_ops ops in - let expr = expr_ops ops in - object (self : ([> 'a lexpr ], 'a lexpr) #ops) - method free = - function - | #lambda as x -> lambda#free x - | #expr as x -> expr#free x - - method subst ~sub = - function - | #lambda as x -> lambda#subst ~sub x - | #expr as x -> expr#subst ~sub x - - method eval = - function - | #lambda as x -> lambda#eval x - | #expr as x -> expr#eval x - end -;; - -let lexpr = lazy_fix lexpr_ops - -let rec print = function - | `Var id -> print_string id - | `Abs (id, l) -> - print_string (" " ^ id ^ " . "); - print l - | `App (l1, l2) -> - print l1; - print_string " "; - print l2 - | `Num x -> print_int x - | `Add (e1, e2) -> - print e1; - print_string " + "; - print e2 - | `Neg e -> - print_string "-"; - print e - | `Mult (e1, e2) -> - print e1; - print_string " * "; - print e2 -;; - -let () = - let e1 = lambda#eval (`App (`Abs ("x", `Var "x"), `Var "y")) in - let e2 = expr#eval (`Add (`Mult (`Num 3, `Neg (`Num 2)), `Var "x")) in - let e3 = - lexpr#eval (`Add (`App (`Abs ("x", `Mult (`Var "x", `Var "x")), `Num 2), `Num 5)) - in - print e1; - print_newline (); - print e2; - print_newline (); - print e3; - print_newline () -;; - -type sexp = - | A of string - | L of sexp list - -type 'a t = 'a array - -let _ = fun (_ : 'a t) -> () -let array_of_sexp _ _ = [||] -let sexp_of_array _ _ = A "foo" -let sexp_of_int _ = A "42" -let int_of_sexp _ = 42 - -let t_of_sexp : 'a. (sexp -> 'a) -> sexp -> 'a t = - let _tp_loc = "core_array.ml.t" in - fun _of_a -> fun t -> (array_of_sexp _of_a) t -;; - -let _ = t_of_sexp - -let sexp_of_t : 'a. ('a -> sexp) -> 'a t -> sexp = - fun _of_a -> fun v -> (sexp_of_array _of_a) v -;; - -let _ = sexp_of_t - -module T = struct - module Int = struct - type t_ = int array - - let _ = fun (_ : t_) -> () - - let t__of_sexp : sexp -> t_ = - let _tp_loc = "core_array.ml.T.Int.t_" in - fun t -> (array_of_sexp int_of_sexp) t - ;; - - let _ = t__of_sexp - let sexp_of_t_ : t_ -> sexp = fun v -> (sexp_of_array sexp_of_int) v - let _ = sexp_of_t_ - end -end - -module type Permissioned = sig - type ('a, -'perms) t -end - -module Permissioned : sig - type ('a, -'perms) t - - include sig - val t_of_sexp : (sexp -> 'a) -> (sexp -> 'perms) -> sexp -> ('a, 'perms) t - val sexp_of_t : ('a -> sexp) -> ('perms -> sexp) -> ('a, 'perms) t -> sexp - end - - module Int : sig - type nonrec -'perms t = (int, 'perms) t - - include sig - val t_of_sexp : (sexp -> 'perms) -> sexp -> 'perms t - val sexp_of_t : ('perms -> sexp) -> 'perms t -> sexp - end - end -end = struct - type ('a, -'perms) t = 'a array - - let _ = fun (_ : ('a, 'perms) t) -> () - - let t_of_sexp : 'a 'perms. (sexp -> 'a) -> (sexp -> 'perms) -> sexp -> ('a, 'perms) t = - let _tp_loc = "core_array.ml.Permissioned.t" in - fun _of_a -> fun _of_perms -> fun t -> (array_of_sexp _of_a) t - ;; - - let _ = t_of_sexp - - let sexp_of_t : 'a 'perms. ('a -> sexp) -> ('perms -> sexp) -> ('a, 'perms) t -> sexp = - fun _of_a -> fun _of_perms -> fun v -> (sexp_of_array _of_a) v - ;; - - let _ = sexp_of_t - - module Int = struct - include T.Int - - type -'perms t = t_ - - let _ = fun (_ : 'perms t) -> () - - let t_of_sexp : 'perms. (sexp -> 'perms) -> sexp -> 'perms t = - let _tp_loc = "core_array.ml.Permissioned.Int.t" in - fun _of_perms -> fun t -> t__of_sexp t - ;; - - let _ = t_of_sexp - - let sexp_of_t : 'perms. ('perms -> sexp) -> 'perms t -> sexp = - fun _of_perms -> fun v -> sexp_of_t_ v - ;; - - let _ = sexp_of_t - end -end - -type 'a foo = - { x : 'a - ; y : int - } - -let r = { { x = 0; y = 0 } with x = 0 } -let r' : string foo = r - -external foo : int = "%ignore" - -let _ = foo () - -type 'a t = [ `A of 'a t t ] as 'a - -(* fails *) - -type 'a t = [ `A of 'a t t ] - -(* fails *) - -type 'a t = [ `A of 'a t t ] constraint 'a = 'a t -type 'a t = [ `A of 'a t ] constraint 'a = 'a t -type 'a t = [ `A of 'a ] as 'a - -type 'a v = [ `A of u v ] constraint 'a = t -and t = u -and u = t - -(* fails *) - -type 'a t = 'a - -let f (x : 'a t as 'a) = () - -(* fails *) - -let f (x : 'a t) (y : 'a) = x = y - -(* PR#6505 *) -module type PR6505 = sig - type 'o is_an_object = < .. > as 'o - and 'o abs constraint 'o = 'o is_an_object - -val abs : 'o is_an_object -> 'o abs -val unabs : 'o abs -> 'o -end - -(* fails *) -(* PR#5835 *) -let f ~x = x + 1;; - -f ?x:0 - -(* PR#6352 *) -let foo (f : unit -> unit) = () -let g ?x () = ();; - -foo - ((); - g) -;; - -(* PR#5748 *) -foo (fun ?opt () -> ()) - -(* fails *) -(* PR#5907 *) - -type 'a t = 'a - -let f (g : 'a list -> 'a t -> 'a) s = g s s -let f (g : 'a * 'b -> 'a t -> 'a) s = g s s - -type ab = - [ `A - | `B - ] - -let f (x : [ `A ]) = - match x with - | #ab -> 1 -;; - -let f x = - ignore - (match x with - | #ab -> 1); - ignore (x : [ `A ]) -;; - -let f x = - ignore - (match x with - | `A | `B -> 1); - ignore (x : [ `A ]) -;; - -let f (x : [< `A | `B ]) = - match x with - | `A | `B | `C -> 0 -;; - -(* warn *) -let f (x : [ `A | `B ]) = - match x with - | `A | `B | `C -> 0 -;; - -(* fail *) - -(* PR#6787 *) -let revapply x f = f x - -let f x (g : [< `Foo ]) = - let y = `Bar x, g in - revapply y (fun (`Bar i, _) -> i) -;; - -(* f : 'a -> [< `Foo ] -> 'a *) - -let rec x = - [| x |]; - 1. -;; - -let rec x = - let u = [| y |] in - 10. - -and y = 1. - -type 'a t -type a - -let f : < .. > t -> unit = fun _ -> () -let g : [< `b ] t -> unit = fun _ -> () -let h : [> `b ] t -> unit = fun _ -> () -let _ = fun (x : a t) -> f x -let _ = fun (x : a t) -> g x -let _ = fun (x : a t) -> h x - -(* PR#7012 *) - -type t = - [ 'A_name - | `Hi - ] - -let f (x : 'id_arg) = x -let f (x : 'Id_arg) = x - -(* undefined labels *) -type t = - { x : int - ; y : int - } -;; - -{ x = 3; z = 2 };; -fun { x = 3; z = 2 } -> ();; - -(* mixed labels *) -{ x = 3; contents = 2 } - -(* private types *) -type u = private { mutable u : int };; - -{ u = 3 };; -fun x -> x.u <- 3 - -(* Punning and abbreviations *) -module M = struct - type t = - { x : int - ; y : int - } -end - -let f { M.x; y } = x + y -let r = { M.x = 1; y = 2 } -let z = f r - -(* messages *) -type foo = { mutable y : int } - -let f (r : int) = r.y <- 3 - -(* bugs *) -type foo = - { y : int - ; z : int - } - -type bar = { x : int } - -let f (r : bar) = ({ r with z = 3 } : foo) - -type foo = { x : int } - -let r : foo = { ZZZ.x = 2 };; - -(ZZZ.X : int option) - -(* PR#5865 *) -let f (x : Complex.t) = x.Complex.z - -(* PR#6394 *) - -module rec X : sig - type t = int * bool -end = struct - type t = - | A - | B - - let f = function - | A | B -> 0 - ;; -end - -(* PR#6768 *) - -type _ prod = Prod : ('a * 'y) prod - -let f : type t. t prod -> _ = function - | Prod -> - let module M = struct - type d = d * d - end - in - () -;; - -let (a : M.a) = 2 -let (b : M.b) = 2 -let _ = A.a = B.b - -module Std = struct - module Hash = Hashtbl -end - -open Std -module Hash1 : module type of Hash = Hash - -module Hash2 : sig - include module type of Hash -end = - Hash - -let f1 (x : (_, _) Hash1.t) = (x : (_, _) Hashtbl.t) -let f2 (x : (_, _) Hash2.t) = (x : (_, _) Hashtbl.t) - -(* Another case, not using include *) - -module Std2 = struct - module M = struct - type t - end -end - -module Std' = Std2 -module M' : module type of Std'.M = Std2.M - -let f3 (x : M'.t) = (x : Std2.M.t) - -(* original report required Core_kernel: - module type S = sig - open Core_kernel.Std - - module Hashtbl1 : module type of Hashtbl - module Hashtbl2 : sig - include (module type of Hashtbl) - end - - module Coverage : Core_kernel.Std.Hashable - - type types = unit constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl1.t - type doesnt_type = unit - constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl2.t - end -*) -module type INCLUDING = sig - include module type of List - include module type of ListLabels -end - -module Including_typed : INCLUDING = struct - include List - include ListLabels -end - -module X = struct - module type SIG = sig - type t = int - - val x : t - end - - module F (Y : SIG) : SIG = struct - type t = Y.t - - let x = Y.x - end -end - -module DUMMY = struct - type t = int - - let x = 2 -end - -let x = (3 : X.F(DUMMY).t) - -module X2 = struct - module type SIG = sig - type t = int - - val x : t - end - - module F (Y : SIG) (Z : SIG) = struct - type t = Y.t - - let x = Y.x - - type t' = Z.t - - let x' = Z.x - end -end - -let x = (3 : X2.F(DUMMY)(DUMMY).t) -let x = (3 : X2.F(DUMMY)(DUMMY).t') - -module F (M : sig - type 'a t - type 'a u = string - - val f : unit -> _ u t - end) = -struct - let t = M.f () -end - -type 't a = [ `A ] -type 't wrap = 't constraint 't = [> 't wrap a ] -type t = t a wrap - -module T = struct - let foo : 't wrap -> 't wrap -> unit = fun _ _ -> () - let bar : 'a a wrap as 'a = `A -end - -module Good : sig - val bar : t - val foo : t -> t -> unit -end = - T - -module Bad : sig - val foo : t -> t -> unit - val bar : t -end = - T - -module M : sig - module type T - - module F (X : T) : sig end -end = struct - module type T = sig end - - module F (X : T) = struct end -end - -module type T = M.T - -module F : functor (X : T) -> sig end = M.F - -module type S = sig - type t = - { a : int - ; b : int - } -end - -let f (module M : S with type t = int) = { M.a = 0 } -let flag = ref false - -module F - (S : sig - module type T - end) - (A : S.T) - (B : S.T) = -struct - module X = (val if !flag then (module A) else (module B) : S.T) -end - -(* If the above were accepted, one could break soundness *) -module type S = sig - type t - - val x : t -end - -module Float = struct - type t = float - - let x = 0.0 -end - -module Int = struct - type t = int - - let x = 0 -end - -module M = F (struct - module type T = S - end) - -let () = flag := false - -module M1 = M (Float) (Int) - -let () = flag := true - -module M2 = M (Float) (Int) - -let _ = [| M2.X.x; M1.X.x |] - -module type PR6513 = sig - module type S = sig - type u - end - - module type T = sig - type 'a wrap - type uri - end - - module Make : functor (Html5 : T with type 'a wrap = 'a) -> - S with type u = < foo : Html5.uri > -end - -(* Requires -package tyxml - module type PR6513_orig = sig - module type S = - sig - type t - type u - end - - module Make: functor (Html5: Html5_sigs.T - with type 'a Xml.wrap = 'a and - type 'a wrap = 'a and - type 'a list_wrap = 'a list) - -> S with type t = Html5_types.div Html5.elt and - type u = < foo: Html5.uri > - end -*) -module type S = sig - include Set.S - - module E : sig - val x : int - end -end - -module Make (O : Set.OrderedType) : S with type elt = O.t = struct - include Set.Make (O) - - module E = struct - let x = 1 - end -end - -module rec A : Set.OrderedType = struct - type t = int - - let compare = Pervasives.compare -end - -and B : S = struct - module C = Make (A) - include C -end - -module type S = sig - module type T - - module X : T -end - -module F (X : S) = X.X - -module M = struct - module type T = sig - type t - end - - module X = struct - type t = int - end -end - -type t = F(M).t - -module Common0 = struct - type msg = Msg - - let handle_msg = ref (function _ -> failwith "Unable to handle message") - - let extend_handle f = - let old = !handle_msg in - handle_msg := f old - ;; - - let q : _ Queue.t = Queue.create () - let add msg = Queue.add msg q - let handle_queue_messages () = Queue.iter !handle_msg q -end - -let q' : Common0.msg Queue.t = Common0.q - -module Common = struct - type msg = .. - - let handle_msg = ref (function _ -> failwith "Unable to handle message") - - let extend_handle f = - let old = !handle_msg in - handle_msg := f old - ;; - - let q : _ Queue.t = Queue.create () - let add msg = Queue.add msg q - let handle_queue_messages () = Queue.iter !handle_msg q -end - -module M1 = struct - type Common.msg += Reload of string | Alert of string - - let handle fallback = function - | Reload s -> print_endline ("Reload " ^ s) - | Alert s -> print_endline ("Alert " ^ s) - | x -> fallback x - ;; - - let () = Common.extend_handle handle - let () = Common.add (Reload "config.file") - let () = Common.add (Alert "Initialisation done") -end - -let should_reject = - let table = Hashtbl.create 1 in - fun x y -> Hashtbl.add table x y -;; - -type 'a t = 'a option - -let is_some = function - | None -> false - | Some _ -> true -;; - -let should_accept ?x () = is_some x - -include struct - let foo `Test = () - let wrap f `Test = f - let bar = wrap () -end - -let f () = - let module S = String in - let module N = Map.Make (S) in - N.add "sum" 41 N.empty -;; - -module X = struct - module Y = struct - module type S = sig - type t - end - end -end - -(* open X (* works! *) *) -module Y = X.Y - -type 'a arg_t = 'at constraint 'a = (module Y.S with type t = 'at) -type t = (module X.Y.S with type t = unit) - -let f (x : t arg_t) = () -let () = f () - -module type S = sig - type a - type b -end - -module Foo - (Bar : S with type a = private [> `A ]) - (Baz : S with type b = private < b : Bar.b ; .. >) = -struct end - -module A = struct - module type A_S = sig end - - type t = (module A_S) -end - -module type S = sig - type t -end - -let f (type a) (module X : S with type t = a) = () -let _ = f (module A) (* ok *) - -module A_annotated_alias : S with type t = (module A.A_S) = A - -let _ = f (module A_annotated_alias) (* ok *) -let _ = f (module A_annotated_alias : S with type t = (module A.A_S)) (* ok *) - -module A_alias = A - -module A_alias_expanded = struct - include A_alias -end - -let _ = f (module A_alias_expanded : S with type t = (module A.A_S)) (* ok *) -let _ = f (module A_alias_expanded) (* ok *) -let _ = f (module A_alias : S with type t = (module A.A_S)) (* doesn't type *) -let _ = f (module A_alias) (* doesn't type either *) - -module Foo - (Bar : sig - type a = private [> `A ] - end) - (Baz : module type of struct - include Bar - end) = -struct end - -module Bazoinks = struct - type a = [ `A ] -end - -module Bug = Foo (Bazoinks) (Bazoinks) -(* PR#6992, reported by Stephen Dolan *) - -type (_, _) eq = Eq : ('a, 'a) eq - -let cast : type a b. (a, b) eq -> a -> b = fun Eq x -> x - -module Fix (F : sig - type 'a f - end) = -struct - type 'a fix = ('a, 'a F.f) eq - - let uniq (type a) (type b) (Eq : a fix) (Eq : b fix) : (a, b) eq = Eq -end - -(* This would allow: - module FixId = Fix (struct type 'a f = 'a end) - let bad : (int, string) eq = FixId.uniq Eq Eq - let _ = Printf.printf "Oh dear: %s" (cast bad 42) -*) -module M = struct - module type S = sig - type a - - val v : a - end - - type 'a s = (module S with type a = 'a) -end - -module B = struct - class type a = object - method a : 'a. 'a M.s -> 'a - end -end - -module M' = M -module B' = B - -class b : B.a = - object - method a : 'a. 'a M.s -> 'a = fun (type a) (module X : M.S with type a = a) -> X.v - method a : 'a. 'a M.s -> 'a = fun (type a) (module X : M.S with type a = a) -> X.v - end - -class b' : B.a = - object - method a : 'a. 'a M'.s -> 'a = fun (type a) (module X : M'.S with type a = a) -> X.v - method a : 'a. 'a M'.s -> 'a = fun (type a) (module X : M'.S with type a = a) -> X.v - end - -module type FOO = sig - type t -end - -module type BAR = sig - (* Works: module rec A : (sig include FOO with type t = < b:B.t > end) *) - module rec A : (FOO with type t = < b : B.t >) - and B : FOO -end - -module A = struct - module type S - - module S = struct end -end - -module F (_ : sig end) = struct - module type S - - module S = A.S -end - -module M = struct end -module N = M -module G (X : F(N).S) : A.S = X - -module F (_ : sig end) = struct - module type S -end - -module M = struct end -module N = M -module G (X : F(N).S) : F(M).S = X - -module M : sig - type make_dec - - val add_dec : make_dec -> unit -end = struct - type u - - module Fast : sig - type 'd t - - val create : unit -> 'd t - - module type S = sig - module Data : sig - type t - end - - val key : Data.t t - end - - module Register (D : S) : sig end - - val attach : 'd t -> 'd -> unit - end = struct - type 'd t = unit - - let create () = () - - module type S = sig - module Data : sig - type t - end - - val key : Data.t t - end - - module Register (D : S) = struct end - - let attach _ _ = () - end - - type make_dec - - module Dem = struct - module Data = struct - type t = make_dec - end - - let key = Fast.create () - end - - module EDem = Fast.Register (Dem) - - let add_dec dec = Fast.attach Dem.key dec -end - -(* simpler version *) - -module Simple = struct - type 'a t - - module type S = sig - module Data : sig - type t - end - - val key : Data.t t - end - - module Register (D : S) = struct - let key = D.key - end - - module M = struct - module Data = struct - type t = int - end - - let key : _ t = Obj.magic () - end -end - -module EM = Simple.Register (Simple.M);; - -Simple.M.key - -module Simple2 = struct - type 'a t - - module type S = sig - module Data : sig - type t - end - - val key : Data.t t - end - - module M = struct - module Data = struct - type t = int - end - - let key : _ t = Obj.magic () - end - - module Register (D : S) = struct - let key = D.key - end - - module EM = Simple.Register (Simple.M) - - let k : M.Data.t t = M.key -end - -module rec M : sig - external f : int -> int = "%identity" -end = struct - external f : int -> int = "%identity" -end -(* with module *) - -module type S = sig - type t - and s = t -end - -module type S' = S with type t := int - -module type S = sig - module rec M : sig end - and N : sig end -end - -module type S' = S with module M := String - -(* with module type *) -(* - module type S = sig module type T module F(X:T) : T end;; - module type T0 = sig type t end;; - module type S1 = S with module type T = T0;; - module type S2 = S with module type T := T0;; - module type S3 = S with module type T := sig type t = int end;; - module H = struct - include (Hashtbl : module type of Hashtbl with - type statistics := Hashtbl.statistics - and module type S := Hashtbl.S - and module Make := Hashtbl.Make - and module MakeSeeded := Hashtbl.MakeSeeded - and module type SeededS := Hashtbl.SeededS - and module type HashedType := Hashtbl.HashedType - and module type SeededHashedType := Hashtbl.SeededHashedType) - end;; -*) - -(* A subtle problem appearing with -principal *) -type -'a t - -class type c = object - method m : [ `A ] t -end - -module M : sig - val v : (#c as 'a) -> 'a -end = struct - let v x = - ignore (x :> c); - x - ;; -end - -(* PR#4838 *) - -let id = - let module M = struct end in - fun x -> x -;; - -(* PR#4511 *) - -let ko = - let module M = struct end in - fun _ -> () -;; - -(* PR#5993 *) - -module M : sig - type -'a t = private int -end = struct - type +'a t = private int -end - -(* PR#6005 *) - -module type A = sig - type t = X of int -end - -type u = X of bool - -module type B = A with type t = u - -(* fail *) - -(* PR#5815 *) -(* ---> duplicated exception name is now an error *) - -module type S = sig - exception Foo of int - exception Foo of bool -end - -(* PR#6410 *) - -module F (X : sig end) = struct - let x = 3 -end -;; - -F.x - -(* fail *) -module C = Char;; - -C.chr 66 - -module C' : module type of Char = C;; - -C'.chr 66 - -module C3 = struct - include Char -end -;; - -C3.chr 66 - -let f x = - let module M = struct - module L = List - end - in - M.L.length x -;; - -let g x = - let module L = List in - L.length (L.map succ x) -;; - -module F (X : sig end) = Char -module C4 = F (struct end);; - -C4.chr 66 - -module G (X : sig end) = struct - module M = X -end - -(* does not alias X *) -module M = G (struct end) - -module M' = struct - module N = struct - let x = 1 - end - - module N' = N -end -;; - -M'.N'.x - -module M'' : sig - module N' : sig - val x : int - end -end = - M' -;; - -M''.N'.x - -module M2 = struct - include M' -end - -module M3 : sig - module N' : sig - val x : int - end -end = struct - include M' -end -;; - -M3.N'.x - -module M3' : sig - module N' : sig - val x : int - end -end = - M2 -;; - -M3'.N'.x - -module M4 : sig - module N' : sig - val x : int - end -end = struct - module N = struct - let x = 1 - end - - module N' = N -end -;; - -M4.N'.x - -module F (X : sig end) = struct - module N = struct - let x = 1 - end - - module N' = N -end - -module G : functor (X : sig end) -> sig - module N' : sig - val x : int - end -end = - F - -module M5 = G (struct end);; - -M5.N'.x - -module M = struct - module D = struct - let y = 3 - end - - module N = struct - let x = 1 - end - - module N' = N -end - -module M1 : sig - module N : sig - val x : int - end - - module N' = N -end = - M -;; - -M1.N'.x - -module M2 : sig - module N' : sig - val x : int - end -end = ( - M : - sig - module N : sig - val x : int - end - - module N' = N - end) -;; - -M2.N'.x - -open M;; - -N'.x - -module M = struct - module C = Char - module C' = C -end - -module M1 : sig - module C : sig - val escaped : char -> string - end - - module C' = C -end = - M -;; - -(* sound, but should probably fail *) -M1.C'.escaped 'A' - -module M2 : sig - module C' : sig - val chr : int -> char - end -end = ( - M : - sig - module C : sig - val chr : int -> char - end - - module C' = C - end) -;; - -M2.C'.chr 66;; -StdLabels.List.map - -module Q = Queue - -exception QE = Q.Empty;; - -try Q.pop (Q.create ()) with -| QE -> "Ok" - -module type Complex = module type of Complex with type t = Complex.t - -module M : sig - module C : Complex -end = struct - module C = Complex -end - -module C = Complex;; - -C.one.Complex.re - -include C - -module F (X : sig - module C = Char - end) = -struct - module C = X.C -end - -(* Applicative functors *) -module S = String -module StringSet = Set.Make (String) -module SSet = Set.Make (S) - -let f (x : StringSet.t) = (x : SSet.t) - -(* Also using include (cf. Leo's mail 2013-11-16) *) -module F (M : sig end) : sig - type t -end = struct - type t = int -end - -module T = struct - module M = struct end - include F (M) -end - -include T - -let f (x : t) : T.t = x - -(* PR#4049 *) -(* This works thanks to abbreviations *) -module A = struct - module B = struct - type t - - let compare x y = 0 - end - - module S = Set.Make (B) - - let empty = S.empty -end - -module A1 = A;; - -A1.empty = A.empty - -(* PR#3476 *) -(* Does not work yet *) -module FF (X : sig end) = struct - type t -end - -module M = struct - module X = struct end - module Y = FF (X) (* XXX *) - - type t = Y.t -end - -module F - (Y : sig - type t - end) - (M : sig - type t = Y.t - end) = -struct end - -module G = F (M.Y) - -(*module N = G (M);; - module N = F (M.Y) (M);;*) - -(* PR#6307 *) - -module A1 = struct end -module A2 = struct end - -module L1 = struct - module X = A1 -end - -module L2 = struct - module X = A2 -end - -module F (L : module type of L1) = struct end -module F1 = F (L1) - -(* ok *) -module F2 = F (L2) - -(* should succeed too *) - -(* Counter example: why we need to be careful with PR#6307 *) -module Int = struct - type t = int - - let compare = compare -end - -module SInt = Set.Make (Int) - -type (_, _) eq = Eq : ('a, 'a) eq -type wrap = W of (SInt.t, SInt.t) eq - -module M = struct - module I = Int - - type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(I).t) eq -end - -module type S = module type of M - -(* keep alias *) - -module Int2 = struct - type t = int - - let compare x y = compare y x -end - -module type S' = sig - module I = Int2 - include S with module I := I -end - -(* fail *) - -(* (* if the above succeeded, one could break invariants *) - module rec M2 : S' = M2;; (* should succeed! (but this is bad) *) - - let M2.W eq = W Eq;; - - let s = List.fold_right SInt.add [1;2;3] SInt.empty;; - module SInt2 = Set.Make(Int2);; - let conv : type a b. (a,b) eq -> a -> b = fun Eq x -> x;; - let s' : SInt2.t = conv eq s;; - SInt2.elements s';; - SInt2.mem 2 s';; (* invariants are broken *) -*) - -(* Check behavior with submodules *) -module M = struct - module N = struct - module I = Int - end - - module P = struct - module I = N.I - end - - module Q = struct - type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(P.I).t) eq - end -end - -module type S = module type of M - -module M = struct - module N = struct - module I = Int - end - - module P = struct - module I = N.I - end - - module Q = struct - type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(N.I).t) eq - end -end - -module type S = module type of M - -(* PR#6365 *) -module type S = sig - module M : sig - type t - - val x : t - end -end - -module H = struct - type t = A - - let x = A -end - -module H' = H - -module type S' = S with module M = H' - -(* shouldn't introduce an alias *) - -(* PR#6376 *) -module type Alias = sig - module N : sig end - module M = N -end - -module F (X : sig end) = struct - type t -end - -module type A = Alias with module N := F(List) - -module rec Bad : A = Bad - -(* Shinwell 2014-04-23 *) -module B = struct - module R = struct - type t = string - end - - module O = R -end - -module K = struct - module E = B - module N = E.O -end - -let x : K.N.t = "foo" - -(* PR#6465 *) - -module M = struct - type t = A - - module B = struct - type u = B - end -end - -module P : sig - type t = M.t = A - - module B = M.B -end = - M - -(* should be ok *) -module P : sig - type t = M.t = A - - module B = M.B -end = struct - include M -end - -module type S = sig - module M : sig - module P : sig end - end - - module Q = M -end - -module type S = sig - module M : sig - module N : sig end - module P : sig end - end - - module Q : sig - module N = M.N - module P = M.P - end -end - -module R = struct - module M = struct - module N = struct end - module P = struct end - end - - module Q = M -end - -module R' : S = R - -(* should be ok *) - -(* PR#6578 *) - -module M = struct - let f x = x -end - -module rec R : sig - module M : sig - val f : 'a -> 'a - end -end = struct - module M = M -end -;; - -R.M.f 3 - -module rec R : sig - module M = M -end = struct - module M = M -end -;; - -R.M.f 3 - -open A - -let f = L.map S.capitalize -let () = L.iter print_endline (f [ "jacques"; "garrigue" ]) - -module C : sig - module L : module type of List -end = struct - include A -end - -(* The following introduces a (useless) dependency on A: - module C : sig module L : module type of List end = A -*) - -include D' - -(* - let () = - print_endline (string_of_int D'.M.y) -*) -open A - -let f = L.map S.capitalize -let () = L.iter print_endline (f [ "jacques"; "garrigue" ]) - -module C : sig - module L : module type of List -end = struct - include A -end - -(* The following introduces a (useless) dependency on A: - module C : sig module L : module type of List end = A -*) - -(* No dependency on D *) -let x = 3 - -module M = struct - let y = 5 -end - -module type S = sig - type u - type t -end - -module type S' = sig - type t = int - type u = bool -end - -(* ok to convert between structurally equal signatures, and parameters - are inferred *) -let f (x : (module S with type t = 'a and type u = 'b)) = (x : (module S')) -let g x = (x : (module S with type t = 'a and type u = 'b) :> (module S')) - -(* with subtyping it is also ok to forget some types *) -module type S2 = sig - type u - type t - type w -end - -let g2 x = (x : (module S2 with type t = 'a and type u = 'b) :> (module S')) -let h x = (x : (module S2 with type t = 'a) :> (module S with type t = 'a)) -let f2 (x : (module S2 with type t = 'a and type u = 'b)) = (x : (module S')) - -(* fail *) -let k (x : (module S2 with type t = 'a)) = (x : (module S with type t = 'a)) - -(* fail *) - -(* but you cannot forget values (no physical coercions) *) -module type S3 = sig - type u - type t - - val x : int -end - -let g3 x = (x : (module S3 with type t = 'a and type u = 'b) :> (module S')) - -(* fail *) -(* Using generative functors *) - -(* Without type *) -module type S = sig - val x : int -end - -let v = - (module struct - let x = 3 - end : S) -;; - -module F () = (val v) - -(* ok *) -module G (X : sig end) : S = F () - -(* ok *) -module H (X : sig end) = (val v) - -(* ok *) - -(* With type *) -module type S = sig - type t - - val x : t -end - -let v = - (module struct - type t = int - - let x = 3 - end : S) -;; - -module F () = (val v) - -(* ok *) -module G (X : sig end) : S = F () - -(* fail *) -module H () = F () - -(* ok *) - -(* Alias *) -module U = struct end -module M = F (struct end) - -(* ok *) -module M = F (U) - -(* fail *) - -(* Cannot coerce between applicative and generative *) -module F1 (X : sig end) = struct end -module F2 : functor () -> sig end = F1 - -(* fail *) -module F3 () = struct end -module F4 : functor (X : sig end) -> sig end = F3 - -(* fail *) - -(* tests for shortened functor notation () *) -module X (X : sig end) (Y : sig end) = functor (Z : sig end) -> struct end -module Y = functor (X : sig end) (Y : sig end) (Z : sig end) -> struct end -module Z = functor (_ : sig end) (_ : sig end) (_ : sig end) -> struct end - -module GZ : functor (X : sig end) () (Z : sig end) -> sig end = - functor (X : sig end) () (Z : sig end) -> struct end - -module F (X : sig end) = struct - type t = int -end - -type t = F(Does_not_exist).t - -type expr = - [ `Abs of string * expr - | `App of expr * expr - ] - -class type exp = object - method eval : (string, exp) Hashtbl.t -> expr -end - -class app e1 e2 : exp = - object - val l = e1 - val r = e2 - - method eval env = - match l with - | `Abs (var, body) -> - Hashtbl.add env var r; - body - | _ -> `App (l, r) - end - -class virtual ['subject, 'event] observer = - object - method virtual notify : 'subject -> 'event -> unit - end - -class ['event] subject = - object (self : 'subject) - val mutable observers = ([] : ('subject, 'event) observer list) - method add_observer obs = observers <- obs :: observers - method notify_observers (e : 'event) = List.iter (fun x -> x#notify self e) observers - end - -type id = int - -class entity (id : id) = - object - val ent_destroy_subject = new subject - method destroy_subject : id subject = ent_destroy_subject - method entity_id = id - end - -class ['entity] entity_container = - object (self) - inherit ['entity, id] observer as observer - method add_entity (e : 'entity) = e#destroy_subject#add_observer self - method notify _ id = () - end - -let f (x : entity entity_container) = () - -(* - class world = - object - val entity_container : entity entity_container = new entity_container - - method add_entity (s : entity) = - entity_container#add_entity (s :> entity) - - end -*) -(* Two v's in the same class *) -class c v = - object - initializer print_endline v - val v = 42 - end -;; - -new c "42" - -(* Two hidden v's in the same class! *) -class c (v : int) = - object - method v0 = v - - inherit - (fun v -> - object - method v : string = v - end) - "42" - end -;; - -(new c 42)#v0 - -class virtual ['a] c = - object (s : 'a) - method virtual m : 'b - end - -let o = - object (s : 'a) - inherit ['a] c - method m = 42 - end -;; - -module M : sig - class x : int -> object - method m : int - end -end = struct - class x _ = - object - method m = 42 - end -end - -module M : sig - class c : 'a -> object - val x : 'b - end -end = struct - class c x = - object - val x = x - end -end - -class c (x : int) = - object - inherit M.c x - method x : bool = x - end - -let r = (new c 2)#x - -(* test.ml *) -class alfa = - object (_ : 'self) - method x : 'a. ('a, out_channel, unit) format -> 'a = Printf.printf - end - -class bravo a = - object - val y = (a :> alfa) - initializer y#x "bravo initialized" - end - -class charlie a = - object - inherit bravo a - initializer y#x "charlie initialized" - end - -(* The module begins *) -exception Out_of_range - -class type ['a] cursor = object - method get : 'a - method incr : unit -> unit - method is_last : bool -end - -class type ['a] storage = object ('self) - method first : 'a cursor - method len : int - method nth : int -> 'a cursor - method copy : 'self - method sub : int -> int -> 'self - method concat : 'a storage -> 'self - method fold : 'b. ('a -> int -> 'b -> 'b) -> 'b -> 'b - method iter : ('a -> unit) -> unit -end - -class virtual ['a, 'cursor] storage_base = - object (self : 'self) - constraint 'cursor = 'a #cursor - method virtual first : 'cursor - method virtual len : int - method virtual copy : 'self - method virtual sub : int -> int -> 'self - method virtual concat : 'a storage -> 'self - - method fold : 'b. ('a -> int -> 'b -> 'b) -> 'b -> 'b = - fun f a0 -> - let cur = self#first in - let rec loop count a = - if count >= self#len - then a - else ( - let a' = f cur#get count a in - cur#incr (); - loop (count + 1) a') - in - loop 0 a0 - - method iter proc = - let p = self#first in - for i = 0 to self#len - 2 do - proc p#get; - p#incr () - done; - if self#len > 0 then proc p#get else () - end - -class type ['a] obj_input_channel = object - method get : unit -> 'a - method close : unit -> unit -end - -class type ['a] obj_output_channel = object - method put : 'a -> unit - method flush : unit -> unit - method close : unit -> unit -end - -module UChar = struct - type t = int - - let highest_bit = 1 lsl 30 - let lower_bits = highest_bit - 1 - - let char_of c = - try Char.chr c with - | Invalid_argument _ -> raise Out_of_range - ;; - - let of_char = Char.code - let code c = if c lsr 30 = 0 then c else raise Out_of_range - let chr n = if n >= 0 && n lsr 31 = 0 then n else raise Out_of_range - let uint_code c = c - let chr_of_uint n = n -end - -type uchar = UChar.t - -let int_of_uchar u = UChar.uint_code u -let uchar_of_int n = UChar.chr_of_uint n - -class type ucursor = [uchar] cursor -class type ustorage = [uchar] storage - -class virtual ['ucursor] ustorage_base = [uchar, 'ucursor] storage_base - -module UText = struct - (* the internal representation is UCS4 with big endian*) - (* The most significant digit appears first. *) - let get_buf s i = - let n = Char.code s.[i] in - let n = (n lsl 8) lor Char.code s.[i + 1] in - let n = (n lsl 8) lor Char.code s.[i + 2] in - let n = (n lsl 8) lor Char.code s.[i + 3] in - UChar.chr_of_uint n - ;; - - let set_buf s i u = - let n = UChar.uint_code u in - s.[i] <- Char.chr (n lsr 24); - s.[i + 1] <- Char.chr ((n lsr 16) lor 0xff); - s.[i + 2] <- Char.chr ((n lsr 8) lor 0xff); - s.[i + 3] <- Char.chr (n lor 0xff) - ;; - - let init_buf buf pos init = - if init#len = 0 - then () - else ( - let cur = init#first in - for i = 0 to init#len - 2 do - set_buf buf (pos + (i lsl 2)) cur#get; - cur#incr () - done; - set_buf buf (pos + ((init#len - 1) lsl 2)) cur#get) - ;; - - let make_buf init = - let s = String.create (init#len lsl 2) in - init_buf s 0 init; - s - ;; - - class text_raw buf = - object (self : 'self) - inherit [cursor] ustorage_base - val contents = buf - method first = new cursor (self :> text_raw) 0 - method len = String.length contents / 4 - method get i = get_buf contents (4 * i) - method nth i = new cursor (self :> text_raw) i - method copy = {<contents = String.copy contents>} - method sub pos len = {<contents = String.sub contents (pos * 4) (len * 4)>} - - method concat (text : ustorage) = - let buf = String.create (String.length contents + (4 * text#len)) in - String.blit contents 0 buf 0 (String.length contents); - init_buf buf (String.length contents) text; - {<contents = buf>} - end - - and cursor text i = - object - val contents = text - val mutable pos = i - method get = contents#get pos - method incr () = pos <- pos + 1 - method is_last = pos + 1 >= contents#len - end - - class string_raw buf = - object - inherit text_raw buf - method set i u = set_buf contents (4 * i) u - end - - class text init = text_raw (make_buf init) - class string init = string_raw (make_buf init) - - let of_string s = - let buf = String.make (4 * String.length s) '\000' in - for i = 0 to String.length s - 1 do - buf.[4 * i] <- s.[i] - done; - new text_raw buf - ;; - - let make len u = - let s = String.create (4 * len) in - for i = 0 to len - 1 do - set_buf s (4 * i) u - done; - new string_raw s - ;; - - let create len = make len (UChar.chr 0) - let copy s = s#copy - let sub s start len = s#sub start len - - let fill s start len u = - for i = start to start + len - 1 do - s#set i u - done - ;; - - let blit src srcoff dst dstoff len = - for i = 0 to len - 1 do - let u = src#get (srcoff + i) in - dst#set (dstoff + i) u - done - ;; - - let concat s1 s2 = s1#concat (s2 (* : #ustorage *) :> uchar storage) - let iter proc s = s#iter proc -end - -class type foo_t = object - method foo : string -end - -type 'a name = - | Foo : foo_t name - | Int : int name - -class foo = - object (self) - method foo = "foo" - - method cast = - function - | Foo -> (self :> < foo : string >) - end - -class foo : foo_t = - object (self) - method foo = "foo" - - method cast : type a. a name -> a = - function - | Foo -> (self :> foo_t) - | _ -> raise Exit - end - -class type c = object end - -module type S = sig - class c : c -end - -class virtual name = object end - -and func (args_ty, ret_ty) = - object (self) - inherit name - val mutable memo_args = None - - method arguments = - match memo_args with - | Some xs -> xs - | None -> - let args = List.map (fun ty -> new argument (self, ty)) args_ty in - memo_args <- Some args; - args - end - -and argument (func, ty) = - object - inherit name - end - -let f (x : #M.foo) = 0 - -class type ['e] t = object ('s) - method update : 'e -> 's -end - -module type S = sig - class base : 'e -> ['e] t -end - -type 'par t = 'par - -module M : sig - val x : < m : 'a. 'a > -end = struct - let x : < m : 'a. 'a t > = Obj.magic () -end - -let ident v = v - -class alias = - object - method alias : 'a. 'a t -> 'a = ident - end - -module Classdef = struct - class virtual ['a, 'b, 'c] cl0 = - object - constraint 'c = < m : 'a -> 'b -> int ; .. > - end - - class virtual ['a, 'b] cl1 = - object - method virtual raise_trouble : int -> 'a - method virtual m : 'a -> 'b -> int - end - - class virtual ['a, 'b] cl2 = - object - method virtual as_cl0 : ('a, 'b, ('a, 'b) cl1) cl0 - end -end - -type refer1 = < poly : 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a) > -type refer2 = < poly : 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a) > - -(* Actually this should succeed ... *) -let f (x : refer1) = (x : refer2) - -module Classdef = struct - class virtual ['a, 'b, 'c] cl0 = - object - constraint 'c = < m : 'a -> 'b -> int ; .. > - end - - class virtual ['a, 'b] cl1 = - object - method virtual raise_trouble : int -> 'a - method virtual m : 'a -> 'b -> int - end - - class virtual ['a, 'b] cl2 = - object - method virtual as_cl0 : ('a, 'b, ('a, 'b) cl1) cl0 - end -end - -module M : sig - type refer = { poly : 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a) } -end = struct - type refer = { poly : 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a) } -end -(* - ocamlc -c pr3918a.mli pr3918b.mli - rm -f pr3918a.cmi - ocamlc -c pr3918c.ml -*) - -open Pr3918b - -let f x = (x : 'a vlist :> 'b vlist) -let f (x : 'a vlist) = (x : 'b vlist) - -module type Poly = sig - type 'a t = 'a constraint 'a = [> ] -end - -module Combine (A : Poly) (B : Poly) = struct - type ('a, 'b) t = 'a A.t constraint 'a = 'b B.t -end - -module C = - Combine - (struct - type 'a t = 'a constraint 'a = [> ] - end) - (struct - type 'a t = 'a constraint 'a = [> ] - end) - -module type Priv = sig - type t = private int -end - -module Make (Unit : sig end) : Priv = struct - type t = int -end - -module A = Make (struct end) - -module type Priv' = sig - type t = private [> `A ] -end - -module Make' (Unit : sig end) : Priv' = struct - type t = [ `A ] -end - -module A' = Make' (struct end) -(* PR5057 *) - -module TT = struct - module IntSet = Set.Make (struct - type t = int - - let compare = compare - end) -end - -let () = - let f flag = - let module T = TT in - let _ = - match flag with - | `A -> 0 - | `B r -> r - in - let _ = - match flag with - | `A -> T.IntSet.mem - | `B r -> r - in - () - in - f `A -;; - -(* This one should fail *) - -let f flag = - let module T = - Set.Make (struct - type t = int - - let compare = compare - end) - in - let _ = - match flag with - | `A -> 0 - | `B r -> r - in - let _ = - match flag with - | `A -> T.mem - | `B r -> r - in - () -;; - -module type S = sig - type +'a t - - val foo : [ `A ] t -> unit - val bar : [< `A | `B ] t -> unit -end - -module Make (T : S) = struct - let f x = - T.foo x; - T.bar x; - (x :> [ `A | `C ] T.t) - ;; -end - -type 'a termpc = - [ `And of 'a * 'a - | `Or of 'a * 'a - | `Not of 'a - | `Atom of string - ] - -type 'a termk = - [ `Dia of 'a - | `Box of 'a - | 'a termpc - ] - -module type T = sig - type term - - val map : (term -> term) -> term -> term - val nnf : term -> term - val nnf_not : term -> term -end - -module Fpc (X : T with type term = private [> 'a termpc ] as 'a) = struct - type term = X.term termpc - - let nnf = function - | `Not (`Atom _) as x -> x - | `Not x -> X.nnf_not x - | x -> X.map X.nnf x - ;; - - let map f : term -> X.term = function - | `Not x -> `Not (f x) - | `And (x, y) -> `And (f x, f y) - | `Or (x, y) -> `Or (f x, f y) - | `Atom _ as x -> x - ;; - - let nnf_not : term -> _ = function - | `Not x -> X.nnf x - | `And (x, y) -> `Or (X.nnf_not x, X.nnf_not y) - | `Or (x, y) -> `And (X.nnf_not x, X.nnf_not y) - | `Atom _ as x -> `Not x - ;; -end - -module Fk (X : T with type term = private [> 'a termk ] as 'a) = struct - type term = X.term termk - - module Pc = Fpc (X) - - let map f : term -> _ = function - | `Dia x -> `Dia (f x) - | `Box x -> `Box (f x) - | #termpc as x -> Pc.map f x - ;; - - let nnf = Pc.nnf - - let nnf_not : term -> _ = function - | `Dia x -> `Box (X.nnf_not x) - | `Box x -> `Dia (X.nnf_not x) - | #termpc as x -> Pc.nnf_not x - ;; -end - -type untyped -type -'a typed = private untyped - -type -'typing wrapped = private sexp -and +'a t = 'a typed wrapped -and sexp = private untyped wrapped - -class type ['a] s3 = object - val underlying : 'a t -end - -class ['a] s3object r : ['a] s3 = - object - val underlying = r - end - -module M (T : sig - type t - end) = -struct - type t = private { t : T.t } -end - -module P = struct - module T = struct - type t - end - - module R = M (T) -end - -module Foobar : sig - type t = private int -end = struct - type t = int -end - -module F0 : sig - type t = private int -end = - Foobar - -let f (x : F0.t) = (x : Foobar.t) - -(* fails *) - -module F = Foobar - -let f (x : F.t) = (x : Foobar.t) - -module M = struct - type t = < m : int > -end - -module M1 : sig - type t = private < m : int ; .. > -end = - M - -module M2 : sig - type t = private < m : int ; .. > -end = - M1 -;; - -fun (x : M1.t) -> (x : M2.t) - -(* fails *) - -module M3 : sig - type t = private M1.t -end = - M1 -;; - -fun x -> (x : M3.t :> M1.t);; -fun x -> (x : M3.t :> M.t) - -module M4 : sig - type t = private M3.t -end = - M2 - -(* fails *) -module M4 : sig - type t = private M3.t -end = - M - -(* fails *) -module M4 : sig - type t = private M3.t -end = - M1 - -(* might be ok *) -module M5 : sig - type t = private M1.t -end = - M3 - -module M6 : sig - type t = private < n : int ; .. > -end = - M1 - -(* fails *) - -module Bar : sig - type t = private Foobar.t - - val f : int -> t -end = struct - type t = int - - let f (x : int) = (x : t) -end - -(* must fail *) - -module M : sig - type t = private T of int - - val mk : int -> t -end = struct - type t = T of int - - let mk x = T x -end - -module M1 : sig - type t = M.t - - val mk : int -> t -end = struct - type t = M.t - - let mk = M.mk -end - -module M2 : sig - type t = M.t - - val mk : int -> t -end = struct - include M -end - -module M3 : sig - type t = M.t - - val mk : int -> t -end = - M - -module M4 : sig - type t = M.t = T of int - - val mk : int -> t -end = - M - -(* Error: The variant or record definition does not match that of type M.t *) - -module M5 : sig - type t = M.t = private T of int - - val mk : int -> t -end = - M - -module M6 : sig - type t = private T of int - - val mk : int -> t -end = - M - -module M' : sig - type t_priv = private T of int - type t = t_priv - - val mk : int -> t -end = struct - type t_priv = T of int - type t = t_priv - - let mk x = T x -end - -module M3' : sig - type t = M'.t - - val mk : int -> t -end = - M' - -module M : sig - type 'a t = private T of 'a -end = struct - type 'a t = T of 'a -end - -module M1 : sig - type 'a t = 'a M.t = private T of 'a -end = struct - type 'a t = 'a M.t = private T of 'a -end - -(* PR#6090 *) -module Test = struct - type t = private A -end - -module Test2 : module type of Test with type t = Test.t = Test - -let f (x : Test.t) = (x : Test2.t) -let f Test2.A = () -let a = Test2.A - -(* fail *) -(* The following should fail from a semantical point of view, - but allow it for backward compatibility *) -module Test2 : module type of Test with type t = private Test.t = Test - -(* PR#6331 *) -type t = private < x : int ; .. > as 'a -type t = private (< x : int ; .. > as 'a) as 'a -type t = private < x : int > as 'a -type t = private (< x : int > as 'a) as 'b -type 'a t = private < x : int ; .. > as 'a -type 'a t = private 'a constraint 'a = < x : int ; .. > - -(* Bad (t = t) *) -module rec A : sig - type t = A.t -end = struct - type t = A.t -end - -(* Bad (t = t) *) -module rec A : sig - type t = B.t -end = struct - type t = B.t -end - -and B : sig - type t = A.t -end = struct - type t = A.t -end - -(* OK (t = int) *) -module rec A : sig - type t = B.t -end = struct - type t = B.t -end - -and B : sig - type t = int -end = struct - type t = int -end - -(* Bad (t = int * t) *) -module rec A : sig - type t = int * A.t -end = struct - type t = int * A.t -end - -(* Bad (t = t -> int) *) -module rec A : sig - type t = B.t -> int -end = struct - type t = B.t -> int -end - -and B : sig - type t = A.t -end = struct - type t = A.t -end - -(* OK (t = <m:t>) *) -module rec A : sig - type t = < m : B.t > -end = struct - type t = < m : B.t > -end - -and B : sig - type t = A.t -end = struct - type t = A.t -end - -(* Bad (not regular) *) -module rec A : sig - type 'a t = < m : 'a list A.t > -end = struct - type 'a t = < m : 'a list A.t > -end - -(* Bad (not regular) *) -module rec A : sig - type 'a t = < m : 'a list B.t ; n : 'a array B.t > -end = struct - type 'a t = < m : 'a list B.t ; n : 'a array B.t > -end - -and B : sig - type 'a t = 'a A.t -end = struct - type 'a t = 'a A.t -end - -(* Bad (not regular) *) -module rec A : sig - type 'a t = 'a B.t -end = struct - type 'a t = 'a B.t -end - -and B : sig - type 'a t = < m : 'a list A.t ; n : 'a array A.t > -end = struct - type 'a t = < m : 'a list A.t ; n : 'a array A.t > -end - -(* OK *) -module rec A : sig - type 'a t = 'a array B.t * 'a list B.t -end = struct - type 'a t = 'a array B.t * 'a list B.t -end - -and B : sig - type 'a t = < m : 'a B.t > -end = struct - type 'a t = < m : 'a B.t > -end - -(* Bad (not regular) *) -module rec A : sig - type 'a t = 'a list B.t -end = struct - type 'a t = 'a list B.t -end - -and B : sig - type 'a t = < m : 'a array B.t > -end = struct - type 'a t = < m : 'a array B.t > -end - -(* Bad (not regular) *) -module rec M : sig - class ['a] c : 'a -> object - method map : ('a -> 'b) -> 'b M.c - end -end = struct - class ['a] c (x : 'a) = - object - method map : 'b. ('a -> 'b) -> 'b M.c = fun f -> new M.c (f x) - end -end - -(* OK *) -class type ['node] extension = object - method node : 'node -end - -and ['ext] node = object - constraint 'ext = ('ext node #extension[@id]) -end - -class x = - object - method node : x node = assert false - end - -type t = x node - -(* Bad - PR 4261 *) - -module PR_4261 = struct - module type S = sig - type t - end - - module type T = sig - module D : S - - type t = D.t - end - - module rec U : (T with module D = U') = U - and U' : (S with type t = U'.t) = U -end - -(* Bad - PR 4512 *) -module type S' = sig - type t = int -end - -module rec M : (S' with type t = M.t) = struct - type t = M.t -end - -(* PR#4450 *) - -module PR_4450_1 = struct - module type MyT = sig - type 'a t = Succ of 'a t - end - - module MyMap (X : MyT) = X - module rec MyList : MyT = MyMap (MyList) -end - -module PR_4450_2 = struct - module type MyT = sig - type 'a wrap = My of 'a t - and 'a t = private < map : 'b. ('a -> 'b) -> 'b wrap ; .. > - - val create : 'a list -> 'a t - end - - module MyMap (X : MyT) = struct - include X - - class ['a] c l = - object (self) - method map : 'b. ('a -> 'b) -> 'b wrap = fun f -> My (create (List.map f l)) - end - end - - module rec MyList : sig - type 'a wrap = My of 'a t - and 'a t = < map : 'b. ('a -> 'b) -> 'b wrap > - - val create : 'a list -> 'a t - end = struct - include MyMap (MyList) - - let create l = new c l - end -end - -(* A synthetic example of bootstrapped data structure - (suggested by J-C Filliatre) *) - -module type ORD = sig - type t - - val compare : t -> t -> int -end - -module type SET = sig - type elt - type t - - val iter : (elt -> unit) -> t -> unit -end - -type 'a tree = - | E - | N of 'a tree * 'a * 'a tree - -module Bootstrap2 - (MakeDiet : functor (X : ORD) -> SET with type t = X.t tree and type elt = X.t) : - SET with type elt = int = struct - type elt = int - - module rec Elt : sig - type t = - | I of int * int - | D of int * Diet.t * int - - val compare : t -> t -> int - val iter : (int -> unit) -> t -> unit - end = struct - type t = - | I of int * int - | D of int * Diet.t * int - - let compare x1 x2 = 0 - - let rec iter f = function - | I (l, r) -> - for i = l to r do - f i - done - | D (_, d, _) -> Diet.iter (iter f) d - ;; - end - - and Diet : (SET with type t = Elt.t tree and type elt = Elt.t) = MakeDiet (Elt) - - type t = Diet.t - - let iter f = Diet.iter (Elt.iter f) -end -(* PR 4470: simplified from OMake's sources *) - -module rec DirElt : sig - type t = - | DirRoot - | DirSub of DirHash.t -end = struct - type t = - | DirRoot - | DirSub of DirHash.t -end - -and DirCompare : sig - type t = DirElt.t -end = struct - type t = DirElt.t -end - -and DirHash : sig - type t = DirElt.t list -end = struct - type t = DirCompare.t list -end -(* PR 4758, PR 4266 *) - -module PR_4758 = struct - module type S = sig end - - module type Mod = sig - module Other : S - end - - module rec A : S = struct end - - and C : sig - include Mod with module Other = A - end = struct - module Other = A - end - - module C' = C (* check that we can take an alias *) - - module F (X : sig end) = struct - type t - end - - let f (x : F(C).t) = (x : F(C').t) -end - -(* PR 4557 *) -module PR_4557 = struct - module F (X : Set.OrderedType) = struct - module rec Mod : sig - module XSet : sig - type elt = X.t - type t = Set.Make(X).t - end - - module XMap : sig - type key = X.t - type 'a t = 'a Map.Make(X).t - end - - type elt = X.t - type t = XSet.t XMap.t - - val compare : t -> t -> int - end = struct - module XSet = Set.Make (X) - module XMap = Map.Make (X) - - type elt = X.t - type t = XSet.t XMap.t - - let compare = fun x y -> 0 - end - - and ModSet : (Set.S with type elt = Mod.t) = Set.Make (Mod) - end -end - -module F (X : Set.OrderedType) = struct - module rec Mod : sig - module XSet : sig - type elt = X.t - type t = Set.Make(X).t - end - - module XMap : sig - type key = X.t - type 'a t = 'a Map.Make(X).t - end - - type elt = X.t - type t = XSet.t XMap.t - - val compare : t -> t -> int - end = struct - module XSet = Set.Make (X) - module XMap = Map.Make (X) - - type elt = X.t - type t = XSet.t XMap.t - - let compare = fun x y -> 0 - end - - and ModSet : (Set.S with type elt = Mod.t) = Set.Make (Mod) -end -(* Tests for recursive modules *) - -let test number result expected = - if result = expected - then Printf.printf "Test %d passed.\n" number - else Printf.printf "Test %d FAILED.\n" number; - flush stdout -;; - -(* Tree of sets *) - -module rec A : sig - type t = - | Leaf of int - | Node of ASet.t - - val compare : t -> t -> int -end = struct - type t = - | Leaf of int - | Node of ASet.t - - let compare x y = - match x, y with - | Leaf i, Leaf j -> Pervasives.compare i j - | Leaf i, Node t -> -1 - | Node s, Leaf j -> 1 - | Node s, Node t -> ASet.compare s t - ;; -end - -and ASet : (Set.S with type elt = A.t) = Set.Make (A) - -let _ = - let x = A.Node (ASet.add (A.Leaf 3) (ASet.singleton (A.Leaf 2))) in - let y = A.Node (ASet.add (A.Leaf 1) (ASet.singleton x)) in - test 10 (A.compare x x) 0; - test 11 (A.compare x (A.Leaf 3)) 1; - test 12 (A.compare (A.Leaf 0) x) (-1); - test 13 (A.compare y y) 0; - test 14 (A.compare x y) 1 -;; - -(* Simple value recursion *) - -module rec Fib : sig - val f : int -> int -end = struct - let f x = if x < 2 then 1 else Fib.f (x - 1) + Fib.f (x - 2) -end - -let _ = test 20 (Fib.f 10) 89 - -(* Update function by infix *) - -module rec Fib2 : sig - val f : int -> int -end = struct - let rec g x = Fib2.f (x - 1) + Fib2.f (x - 2) - and f x = if x < 2 then 1 else g x -end - -let _ = test 21 (Fib2.f 10) 89 - -(* Early application *) - -let _ = - let res = - try - let module A = struct - module rec Bad : sig - val f : int -> int - end = struct - let f = - let y = Bad.f 5 in - fun x -> x + y - ;; - end - end - in - false - with - | Undefined_recursive_module _ -> true - in - test 30 res true -;; - -(* Early strict evaluation *) - -(* - module rec Cyclic - : sig val x : int end - = struct let x = Cyclic.x + 1 end - ;; -*) - -(* Reordering of evaluation based on dependencies *) - -module rec After : sig - val x : int -end = struct - let x = Before.x + 1 -end - -and Before : sig - val x : int -end = struct - let x = 3 -end - -let _ = test 40 After.x 4 - -(* Type identity between A.t and t within A's definition *) - -module rec Strengthen : sig - type t - - val f : t -> t -end = struct - type t = - | A - | B - - let _ = (A : Strengthen.t) - let f x = if true then A else Strengthen.f B -end - -module rec Strengthen2 : sig - type t - - val f : t -> t - - module M : sig - type u - end - - module R : sig - type v - end -end = struct - type t = - | A - | B - - let _ = (A : Strengthen2.t) - let f x = if true then A else Strengthen2.f B - - module M = struct - type u = C - - let _ = (C : Strengthen2.M.u) - end - - module rec R : sig - type v = Strengthen2.R.v - end = struct - type v = D - - let _ = (D : R.v) - let _ = (D : Strengthen2.R.v) - end -end - -(* Polymorphic recursion *) - -module rec PolyRec : sig - type 'a t = - | Leaf of 'a - | Node of 'a list t * 'a list t - - val depth : 'a t -> int -end = struct - type 'a t = - | Leaf of 'a - | Node of 'a list t * 'a list t - - let x = (PolyRec.Leaf 1 : int t) - - let depth = function - | Leaf x -> 0 - | Node (l, r) -> 1 + max (PolyRec.depth l) (PolyRec.depth r) - ;; -end - -(* Wrong LHS signatures (PR#4336) *) - -(* - module type ASig = sig type a val a:a val print:a -> unit end - module type BSig = sig type b val b:b val print:b -> unit end - - module A = struct type a = int let a = 0 let print = print_int end - module B = struct type b = float let b = 0.0 let print = print_float end - - module MakeA (Empty:sig end) : ASig = A - module MakeB (Empty:sig end) : BSig = B - - module - rec NewA : ASig = MakeA (struct end) - and NewB : BSig with type b = NewA.a = MakeB (struct end);; -*) - -(* Expressions and bindings *) - -module StringSet = Set.Make (String) - -module rec Expr : sig - type t = - | Var of string - | Const of int - | Add of t * t - | Binding of Binding.t * t - - val make_let : string -> t -> t -> t - val fv : t -> StringSet.t - val simpl : t -> t -end = struct - type t = - | Var of string - | Const of int - | Add of t * t - | Binding of Binding.t * t - - let make_let id e1 e2 = Binding ([ id, e1 ], e2) - - let rec fv = function - | Var s -> StringSet.singleton s - | Const n -> StringSet.empty - | Add (t1, t2) -> StringSet.union (fv t1) (fv t2) - | Binding (b, t) -> - StringSet.union (Binding.fv b) (StringSet.diff (fv t) (Binding.bv b)) - ;; - - let rec simpl = function - | Var s -> Var s - | Const n -> Const n - | Add (Const i, Const j) -> Const (i + j) - | Add (Const 0, t) -> simpl t - | Add (t, Const 0) -> simpl t - | Add (t1, t2) -> Add (simpl t1, simpl t2) - | Binding (b, t) -> Binding (Binding.simpl b, simpl t) - ;; -end - -and Binding : sig - type t = (string * Expr.t) list - - val fv : t -> StringSet.t - val bv : t -> StringSet.t - val simpl : t -> t -end = struct - type t = (string * Expr.t) list - - let fv b = - List.fold_left (fun v (id, e) -> StringSet.union v (Expr.fv e)) StringSet.empty b - ;; - - let bv b = List.fold_left (fun v (id, e) -> StringSet.add id v) StringSet.empty b - let simpl b = List.map (fun (id, e) -> id, Expr.simpl e) b -end - -let _ = - let e = Expr.make_let "x" (Expr.Add (Expr.Var "y", Expr.Const 0)) (Expr.Var "x") in - let e' = Expr.make_let "x" (Expr.Var "y") (Expr.Var "x") in - test 50 (StringSet.elements (Expr.fv e)) [ "y" ]; - test 51 (Expr.simpl e) e' -;; - -(* Okasaki's bootstrapping *) - -module type ORDERED = sig - type t - - val eq : t -> t -> bool - val lt : t -> t -> bool - val leq : t -> t -> bool -end - -module type HEAP = sig - module Elem : ORDERED - - type heap - - val empty : heap - val isEmpty : heap -> bool - val insert : Elem.t -> heap -> heap - val merge : heap -> heap -> heap - val findMin : heap -> Elem.t - val deleteMin : heap -> heap -end - -module Bootstrap - (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) - (Element : ORDERED) : HEAP with module Elem = Element = struct - module Elem = Element - - module rec BE : sig - type t = - | E - | H of Elem.t * PrimH.heap - - val eq : t -> t -> bool - val lt : t -> t -> bool - val leq : t -> t -> bool - end = struct - type t = - | E - | H of Elem.t * PrimH.heap - - let leq t1 t2 = - match t1, t2 with - | H (x, _), H (y, _) -> Elem.leq x y - | H _, E -> false - | E, H _ -> true - | E, E -> true - ;; - - let eq t1 t2 = - match t1, t2 with - | H (x, _), H (y, _) -> Elem.eq x y - | H _, E -> false - | E, H _ -> false - | E, E -> true - ;; - - let lt t1 t2 = - match t1, t2 with - | H (x, _), H (y, _) -> Elem.lt x y - | H _, E -> false - | E, H _ -> true - | E, E -> false - ;; - end - - and PrimH : (HEAP with type Elem.t = BE.t) = MakeH (BE) - - type heap = BE.t - - let empty = BE.E - - let isEmpty = function - | BE.E -> true - | _ -> false - ;; - - let rec merge x y = - match x, y with - | BE.E, _ -> y - | _, BE.E -> x - | (BE.H (e1, p1) as h1), (BE.H (e2, p2) as h2) -> - if Elem.leq e1 e2 - then BE.H (e1, PrimH.insert h2 p1) - else BE.H (e2, PrimH.insert h1 p2) - ;; - - let insert x h = merge (BE.H (x, PrimH.empty)) h - - let findMin = function - | BE.E -> raise Not_found - | BE.H (x, _) -> x - ;; - - let deleteMin = function - | BE.E -> raise Not_found - | BE.H (x, p) -> - if PrimH.isEmpty p - then BE.E - else ( - match PrimH.findMin p with - | BE.H (y, p1) -> - let p2 = PrimH.deleteMin p in - BE.H (y, PrimH.merge p1 p2) - | BE.E -> assert false) - ;; -end - -module LeftistHeap (Element : ORDERED) : HEAP with module Elem = Element = struct - module Elem = Element - - type heap = - | E - | T of int * Elem.t * heap * heap - - let rank = function - | E -> 0 - | T (r, _, _, _) -> r - ;; - - let make x a b = - if rank a >= rank b then T (rank b + 1, x, a, b) else T (rank a + 1, x, b, a) - ;; - - let empty = E - - let isEmpty = function - | E -> true - | _ -> false - ;; - - let rec merge h1 h2 = - match h1, h2 with - | _, E -> h1 - | E, _ -> h2 - | T (_, x1, a1, b1), T (_, x2, a2, b2) -> - if Elem.leq x1 x2 then make x1 a1 (merge b1 h2) else make x2 a2 (merge h1 b2) - ;; - - let insert x h = merge (T (1, x, E, E)) h - - let findMin = function - | E -> raise Not_found - | T (_, x, _, _) -> x - ;; - - let deleteMin = function - | E -> raise Not_found - | T (_, x, a, b) -> merge a b - ;; -end - -module Ints = struct - type t = int - - let eq = ( = ) - let lt = ( < ) - let leq = ( <= ) -end - -module C = Bootstrap (LeftistHeap) (Ints) - -let _ = - let h = List.fold_right C.insert [ 6; 4; 8; 7; 3; 1 ] C.empty in - test 60 (C.findMin h) 1; - test 61 (C.findMin (C.deleteMin h)) 3; - test 62 (C.findMin (C.deleteMin (C.deleteMin h))) 4 -;; - -(* Classes *) - -module rec Class1 : sig - class c : object - method m : int -> int - end -end = struct - class c = - object - method m x = if x <= 0 then x else (new Class2.d)#m x - end -end - -and Class2 : sig - class d : object - method m : int -> int - end -end = struct - class d = - object (self) - inherit Class1.c as super - method m (x : int) = super#m 0 - end -end - -let _ = test 70 ((new Class1.c)#m 7) 0 - -let _ = - try - let module A = struct - module rec BadClass1 : sig - class c : object - method m : int - end - end = struct - class c = - object - method m = 123 - end - end - - and BadClass2 : sig - val x : int - end = struct - let x = (new BadClass1.c)#m - end - end - in - test 71 true false - with - | Undefined_recursive_module _ -> test 71 true true -;; - -(* Coercions *) - -module rec Coerce1 : sig - val g : int -> int - val f : int -> int -end = struct - module A : sig - val f : int -> int - end = - Coerce1 - - let g x = x - let f x = if x <= 0 then 1 else A.f (x - 1) * x -end - -let _ = test 80 (Coerce1.f 10) 3628800 - -module CoerceF (S : sig end) = struct - let f1 () = 1 - let f2 () = 2 - let f3 () = 3 - let f4 () = 4 - let f5 () = 5 -end - -module rec Coerce2 : sig - val f1 : unit -> int -end = - CoerceF (Coerce3) - -and Coerce3 : sig end = struct end - -let _ = test 81 (Coerce2.f1 ()) 1 - -module Coerce4 (A : sig - val f : int -> int - end) = -struct - let x = 0 - let at a = A.f a -end - -module rec Coerce5 : sig - val blabla : int -> int - val f : int -> int -end = struct - let blabla x = 0 - let f x = 5 -end - -and Coerce6 : sig - val at : int -> int -end = - Coerce4 (Coerce5) - -let _ = test 82 (Coerce6.at 100) 5 - -(* Miscellaneous bug reports *) - -module rec F : sig - type t = - | X of int - | Y of int - - val f : t -> bool -end = struct - type t = - | X of int - | Y of int - - let f = function - | X _ -> false - | _ -> true - ;; -end - -let _ = - test 100 (F.f (F.X 1)) false; - test 101 (F.f (F.Y 2)) true -;; - -(* PR#4316 *) -module G (S : sig - val x : int Lazy.t - end) = -struct - include S -end - -module M1 = struct - let x = lazy 3 -end - -let _ = Lazy.force M1.x - -module rec M2 : sig - val x : int Lazy.t -end = - G (M1) - -let _ = test 102 (Lazy.force M2.x) 3 -let _ = Gc.full_major () (* will shortcut forwarding in M1.x *) - -module rec M3 : sig - val x : int Lazy.t -end = - G (M1) - -let _ = test 103 (Lazy.force M3.x) 3 - -(** Pure type-checking tests: see recmod/*.ml *) -type t = - | A of - { x : int - ; mutable y : int - } - -let f (A r) = r - -(* -> escape *) -let f (A r) = r.x - -(* ok *) -let f x = A { x; y = x } - -(* ok *) -let f (A r) = A { r with y = r.x + 1 } - -(* ok *) -let f () = A { a = 1 } - -(* customized error message *) -let f () = A { x = 1; y = 3 } - -(* ok *) - -type _ t = - | A : - { x : 'a - ; y : 'b - } - -> 'a t - -let f (A { x; y }) = A { x; y = () } - -(* ok *) -let f (A ({ x; y } as r)) = A { x = r.x; y = r.y } - -(* ok *) - -module M = struct - type 'a t = - | A of { x : 'a } - | B : { u : 'b } -> unit t - - exception Foo of { x : int } -end - -module N : sig - type 'b t = 'b M.t = - | A of { x : 'b } - | B : { u : 'bla } -> unit t - - exception Foo of { x : int } -end = struct - type 'b t = 'b M.t = - | A of { x : 'b } - | B : { u : 'z } -> unit t - - exception Foo = M.Foo -end - -module type S = sig - exception A of { x : int } -end - -module F (X : sig - val x : (module S) - end) = -struct - module A = (val X.x) -end - -(* -> this expression creates fresh types (not really!) *) - -module type S = sig - exception A of { x : int } - exception A of { x : string } -end - -module M = struct - exception A of { x : int } - exception A of { x : string } -end - -module M1 = struct - exception A of { x : int } -end - -module M = struct - include M1 - include M1 -end - -module type S1 = sig - exception A of { x : int } -end - -module type S = sig - include S1 - include S1 -end - -module M = struct - exception A = M1.A -end - -module X1 = struct - type t = .. -end - -module X2 = struct - type t = .. -end - -module Z = struct - type X1.t += A of { x : int } - type X2.t += A of { x : int } -end - -(* PR#6716 *) - -type _ c = C : [ `A ] c -type t = T : { x : [< `A ] c } -> t - -let f (T { x = C }) = () - -module M : sig - type 'a t - - type u = u t - and v = v t - - val f : int -> u - val g : v -> bool -end = struct - type 'a t = 'a - - type u = int - and v = bool - - let f x = x - let g x = x -end - -let h (x : int) : bool = M.g (M.f x) - -type _ t = C : ((('a -> 'o) -> 'o) -> ('b -> 'o) -> 'o) t - -let f : type a o. ((a -> o) -> o) t -> (a -> o) -> o = fun C k -> k (fun x -> x) - -module type T = sig - type 'a t -end - -module Fix (T : T) = struct - type r = 'r T.t as 'r -end - -type _ t = - | X of string - | Y : bytes t - -let y : string t = Y - -let f : string A.t -> unit = function - | A.X s -> print_endline s -;; - -let () = f A.y - -module rec A : sig - type t -end = struct - type t = - { a : unit - ; b : unit - } - - let _ = { a = () } -end - -type t = - [ `A - | `B - ] - -type 'a u = t - -let a : [< int u ] = `A - -type 'a s = 'a - -let b : [< t s ] = `B - -module Core = struct - module Int = struct - module T = struct - type t = int - - let compare = compare - let ( + ) x y = x + y - end - - include T - module Map = Map.Make (T) - end - - module Std = struct - module Int = Int - end -end - -open Core.Std - -let x = Int.Map.empty -let y = x + x - -(* Avoid ambiguity *) - -module M = struct - type t = A - type u = C -end - -module N = struct - type t = B -end - -open M -open N;; - -A;; -B;; -C - -include M -open M;; - -C - -module L = struct - type v = V -end - -open L;; - -V - -module L = struct - type v = V -end - -open L;; - -V - -type t1 = A - -module M1 = struct - type u = v - and v = t1 -end - -module N1 = struct - type u = v - and v = M1.v -end - -type t1 = B - -module N2 = struct - type u = v - and v = M1.v -end - -(* PR#6566 *) -module type PR6566 = sig - type t = string -end - -module PR6566 = struct - type t = int -end - -module PR6566' : PR6566 = PR6566 - -module A = struct - module B = struct - type t = T - end -end - -module M2 = struct - type u = A.B.t - type foo = int - type v = A.B.t -end - -(* Adapted from: An Expressive Language of Signatures - by Norman Ramsey, Kathleen Fisher and Paul Govereau *) - -module type VALUE = sig - type value (* a Lua value *) - type state (* the state of a Lua interpreter *) - type usert (* a user-defined value *) -end - -module type CORE0 = sig - module V : VALUE - - val setglobal : V.state -> string -> V.value -> unit - (* five more functions common to core and evaluator *) -end - -module type CORE = sig - include CORE0 - - val apply : V.value -> V.state -> V.value list -> V.value - (* apply function f in state s to list of args *) -end - -module type AST = sig - module Value : VALUE - - type chunk - type program - - val get_value : chunk -> Value.value -end - -module type EVALUATOR = sig - module Value : VALUE - module Ast : AST with module Value := Value - - type state = Value.state - type value = Value.value - - exception Error of string - - val compile : Ast.program -> string - - include CORE0 with module V := Value -end - -module type PARSER = sig - type chunk - - val parse : string -> chunk -end - -module type INTERP = sig - include EVALUATOR - module Parser : PARSER with type chunk = Ast.chunk - - val dostring : state -> string -> value list - val mk : unit -> state -end - -module type USERTYPE = sig - type t - - val eq : t -> t -> bool - val to_string : t -> string -end - -module type TYPEVIEW = sig - type combined - type t - - val map : (combined -> t) * (t -> combined) -end - -module type COMBINED_COMMON = sig - module T : sig - type t - end - - module TV1 : TYPEVIEW with type combined := T.t - module TV2 : TYPEVIEW with type combined := T.t -end - -module type COMBINED_TYPE = sig - module T : USERTYPE - include COMBINED_COMMON with module T := T -end - -module type BARECODE = sig - type state - - val init : state -> unit -end - -module USERCODE (X : TYPEVIEW) = struct - module type F = functor (C : CORE with type V.usert = X.combined) -> - BARECODE with type state := C.V.state -end - -module Weapon = struct - type t -end - -module type WEAPON_LIB = sig - type t = Weapon.t - - module T : USERTYPE with type t = t - module Make : functor (TV : TYPEVIEW with type t = t) -> USERCODE(TV).F -end - -module type X = functor (X : CORE) -> BARECODE -module type X = functor (_ : CORE) -> BARECODE - -module M = struct - type t = int * (< m : 'a > as 'a) -end - -module type S = sig - module M : sig - type t - end -end -with module M = M - -module type Printable = sig - type t - - val print : Format.formatter -> t -> unit -end - -module type Comparable = sig - type t - - val compare : t -> t -> int -end - -module type PrintableComparable = sig - include Printable - include Comparable with type t = t -end - -(* Fails *) -module type PrintableComparable = sig - type t - - include Printable with type t := t - include Comparable with type t := t -end - -module type PrintableComparable = sig - include Printable - include Comparable with type t := t -end - -module type ComparableInt = Comparable with type t := int - -module type S = sig - type t - - val f : t -> t -end - -module type S' = S with type t := int - -module type S = sig - type 'a t - - val map : ('a -> 'b) -> 'a t -> 'b t -end - -module type S1 = S with type 'a t := 'a list - -module type S2 = sig - type 'a dict = (string * 'a) list - - include S with type 'a t := 'a dict -end - -module type S = sig - module T : sig - type exp - type arg - end - - val f : T.exp -> T.arg -end - -module M = struct - type exp = string - type arg = int -end - -module type S' = S with module T := M - -module type S = sig - type 'a t -end -with type 'a t := unit - -(* Fails *) -let property (type t) () = - let module M = struct - exception E of t - end - in - ( (fun x -> M.E x) - , function - | M.E x -> Some x - | _ -> None ) -;; - -let () = - let int_inj, int_proj = property () in - let string_inj, string_proj = property () in - let i = int_inj 3 in - let s = string_inj "abc" in - Printf.printf "%B\n%!" (int_proj i = None); - Printf.printf "%B\n%!" (int_proj s = None); - Printf.printf "%B\n%!" (string_proj i = None); - Printf.printf "%B\n%!" (string_proj s = None) -;; - -let sort_uniq (type s) cmp l = - let module S = - Set.Make (struct - type t = s - - let compare = cmp - end) - in - S.elements (List.fold_right S.add l S.empty) -;; - -let () = print_endline (String.concat "," (sort_uniq compare [ "abc"; "xyz"; "abc" ])) -let f x (type a) (y : a) = x = y - -(* Fails *) -class ['a] c = - object (self) - method m : 'a -> 'a = fun x -> x - method n : 'a -> 'a = fun (type g) (x : g) -> self#m x - end - -(* Fails *) - -external a : (int[@untagged]) -> unit = "a" "a_nat" -external b : (int32[@unboxed]) -> unit = "b" "b_nat" -external c : (int64[@unboxed]) -> unit = "c" "c_nat" -external d : (nativeint[@unboxed]) -> unit = "d" "d_nat" -external e : (float[@unboxed]) -> unit = "e" "e_nat" - -type t = private int - -external f : (t[@untagged]) -> unit = "f" "f_nat" - -module M : sig - external a : int -> (int[@untagged]) = "a" "a_nat" - external b : (int[@untagged]) -> int = "b" "b_nat" -end = struct - external a : int -> (int[@untagged]) = "a" "a_nat" - external b : (int[@untagged]) -> int = "b" "b_nat" -end - -module Global_attributes = struct - [@@@ocaml.warning "-3"] - - external a : float -> float = "a" "noalloc" "a_nat" "float" - external b : float -> float = "b" "noalloc" "b_nat" - external c : float -> float = "c" "c_nat" "float" - external d : float -> float = "d" "noalloc" - external e : float -> float = "e" - - (* Should output a warning: no native implementation provided *) - external f : (int32[@unboxed]) -> (int32[@unboxed]) = "f" "noalloc" - external g : int32 -> int32 = "g" "g_nat" [@@unboxed] [@@noalloc] - external h : (int[@untagged]) -> (int[@untagged]) = "h" "h_nat" "noalloc" - external i : int -> int = "i" "i_nat" [@@untagged] [@@noalloc] -end - -module Old_style_warning = struct - [@@@ocaml.warning "+3"] - - external a : float -> float = "a" "noalloc" "a_nat" "float" - external b : float -> float = "b" "noalloc" "b_nat" - external c : float -> float = "c" "c_nat" "float" - external d : float -> float = "d" "noalloc" - external e : float -> float = "c" "float" -end - -(* Bad: attributes not reported in the interface *) - -module Bad1 : sig - external f : int -> int = "f" "f_nat" -end = struct - external f : int -> (int[@untagged]) = "f" "f_nat" -end - -module Bad2 : sig - external f : int -> int = "a" "a_nat" -end = struct - external f : (int[@untagged]) -> int = "f" "f_nat" -end - -module Bad3 : sig - external f : float -> float = "f" "f_nat" -end = struct - external f : float -> (float[@unboxed]) = "f" "f_nat" -end - -module Bad4 : sig - external f : float -> float = "a" "a_nat" -end = struct - external f : (float[@unboxed]) -> float = "f" "f_nat" -end - -(* Bad: attributes in the interface but not in the implementation *) - -module Bad5 : sig - external f : int -> (int[@untagged]) = "f" "f_nat" -end = struct - external f : int -> int = "f" "f_nat" -end - -module Bad6 : sig - external f : (int[@untagged]) -> int = "f" "f_nat" -end = struct - external f : int -> int = "a" "a_nat" -end - -module Bad7 : sig - external f : float -> (float[@unboxed]) = "f" "f_nat" -end = struct - external f : float -> float = "f" "f_nat" -end - -module Bad8 : sig - external f : (float[@unboxed]) -> float = "f" "f_nat" -end = struct - external f : float -> float = "a" "a_nat" -end - -(* Bad: unboxed or untagged with the wrong type *) - -external g : (float[@untagged]) -> float = "g" "g_nat" -external h : (int[@unboxed]) -> float = "h" "h_nat" - -(* Bad: unboxing the function type *) -external i : (int -> float[@unboxed]) = "i" "i_nat" - -(* Bad: unboxing a "deep" sub-type. *) -external j : int -> (float[@unboxed]) * float = "j" "j_nat" - -(* This should be rejected, but it is quite complicated to do - in the current state of things *) - -external k : int -> (float[@unboxd]) = "k" "k_nat" - -(* Bad: old style annotations + new style attributes *) - -external l : float -> float = "l" "l_nat" "float" [@@unboxed] -external m : (float[@unboxed]) -> float = "m" "m_nat" "float" -external n : float -> float = "n" "noalloc" [@@noalloc] - -(* Warnings: unboxed / untagged without any native implementation *) -external o : (float[@unboxed]) -> float = "o" -external p : float -> (float[@unboxed]) = "p" -external q : (int[@untagged]) -> float = "q" -external r : int -> (int[@untagged]) = "r" -external s : int -> int = "s" [@@untagged] -external t : float -> float = "t" [@@unboxed] - -let _ = ignore ( + ) -let _ = raise Exit 3;; - -(* comment 9644 of PR#6000 *) - -fun b -> if b then format_of_string "x" else "y";; -fun b -> if b then "x" else format_of_string "y";; -fun b : (_, _, _) format -> if b then "x" else "y" - -(* PR#7135 *) - -module PR7135 = struct - module M : sig - type t = private int - end = struct - type t = int - end - - include M - - let lift2 (f : int -> int -> int) (x : t) (y : t) = f (x :> int) (y :> int) -end - -(* exemple of non-ground coercion *) - -module Test1 = struct - type t = private int - - let f x = - let y = if true then x else (x : t) in - (y :> int) - ;; -end - -(* Warn about all relevant cases when possible *) -let f = function - | None, None -> 1 - | Some _, Some _ -> 2 -;; - -(* Exhaustiveness check is very slow *) -type _ t = - | A : int t - | B : bool t - | C : char t - | D : float t - -type (_, _, _, _) u = U : (int, int, int, int) u - -type v = - | E - | F - | G - -let f - : type a b c d e f g. - a t * b t * c t * d t * e t * f t * g t * v * (a, b, c, d) u * (e, f, g, g) u -> int - = function - | A, A, A, A, A, A, A, _, U, U -> 1 - | _, _, _, _, _, _, _, G, _, _ -> 1 -;; - -(*| _ -> _ *) - -(* Unused cases *) -let f (x : int t) = - match x with - | A -> 1 - | _ -> 2 -;; - -(* warn *) -let f (x : unit t option) = - match x with - | None -> 1 - | _ -> 2 -;; - -(* warn? *) -let f (x : unit t option) = - match x with - | None -> 1 - | Some _ -> 2 -;; - -(* warn *) -let f (x : int t option) = - match x with - | None -> 1 - | _ -> 2 -;; - -let f (x : int t option) = - match x with - | None -> 1 -;; - -(* warn *) - -(* Example with record, type, single case *) - -type 'a box = Box of 'a - -type 'a pair = - { left : 'a - ; right : 'a - } - -let f : (int t box pair * bool) option -> unit = function - | None -> () -;; - -let f : (string t box pair * bool) option -> unit = function - | None -> () -;; - -(* Examples from ML2015 paper *) - -type _ t = - | Int : int t - | Bool : bool t - -let f : type a. a t -> a = function - | Int -> 1 - | Bool -> true -;; - -let g : int t -> int = function - | Int -> 1 -;; - -let h : type a. a t -> a t -> bool = - fun x y -> - match x, y with - | Int, Int -> true - | Bool, Bool -> true -;; - -type (_, _) cmp = - | Eq : ('a, 'a) cmp - | Any : ('a, 'b) cmp - -module A : sig - type a - type b - - val eq : (a, b) cmp -end = struct - type a - type b = a - - let eq = Eq -end - -let f : (A.a, A.b) cmp -> unit = function - | Any -> () -;; - -let deep : char t option -> char = function - | None -> 'c' -;; - -type zero = Zero -type _ succ = Succ - -type (_, _, _) plus = - | Plus0 : (zero, 'a, 'a) plus - | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus - -let trivial : (zero succ, zero, zero) plus option -> bool = function - | None -> false -;; - -let easy : (zero, zero succ, zero) plus option -> bool = function - | None -> false -;; - -let harder : (zero succ, zero succ, zero succ) plus option -> bool = function - | None -> false -;; - -let harder : (zero succ, zero succ, zero succ) plus option -> bool = function - | None -> false - | Some (PlusS _) -> . -;; - -let inv_zero : type a b c d. (a, b, c) plus -> (c, d, zero) plus -> bool = - fun p1 p2 -> - match p1, p2 with - | Plus0, Plus0 -> true -;; - -(* Empty match *) - -type _ t = Int : int t - -let f (x : bool t) = - match x with - | _ -> . -;; - -(* ok *) - -(* trefis in PR#6437 *) - -let f () = - match None with - | _ -> . -;; - -(* error *) -let g () = - match None with - | _ -> () - | exception _ -> . -;; - -(* error *) -let h () = - match None with - | _ -> . - | exception _ -> . -;; - -(* error *) -let f x = - match x with - | _ -> () - | None -> . -;; - -(* do not warn *) - -(* #7059, all clauses guarded *) - -let f x y = - match 1 with - | 1 when x = y -> 1 -;; - -open CamlinternalOO - -type _ choice = - | Left : label choice - | Right : tag choice - -let f : label choice -> bool = function - | Left -> true -;; - -(* warn *) -exception A - -type a = A;; - -A;; -raise A;; -fun (A : a) -> ();; - -function -| Not_found -> 1 -| A -> 2 -| _ -> 3 -;; - -try raise A with -| A -> 2 - -module TypEq = struct - type (_, _) t = Eq : ('a, 'a) t -end - -module type T = sig - type _ is_t = Is : ('a, 'b) TypEq.t -> 'a is_t - - val is_t : unit -> unit is_t option -end - -module Make (M : T) = struct - let _ = - match M.is_t () with - | None -> 0 - | Some _ -> 0 - ;; - - let f () = - match M.is_t () with - | None -> 0 - ;; -end - -module Make2 (M : T) = struct - type t = T of unit M.is_t - - let g : t -> int = function - | _ -> . - ;; -end - -type t = A : t - -module X1 : sig end = struct - let _f ~x (* x unused argument *) = function - | A -> - let x = () in - x - ;; -end - -module X2 : sig end = struct - let x = 42 (* unused value *) - - let _f = function - | A -> - let x = () in - x - ;; -end - -module X3 : sig end = struct - module O = struct - let x = 42 (* unused *) - end - - open O (* unused open *) - - let _f = function - | A -> - let x = () in - x - ;; -end - -(* Use type information *) -module M1 = struct - type t = - { x : int - ; y : int - } - - type u = - { x : bool - ; y : bool - } -end - -module OK = struct - open M1 - - let f1 (r : t) = r.x (* ok *) - - let f2 r = - ignore (r : t); - r.x (* non principal *) - ;; - - let f3 (r : t) = - match r with - | { x; y } -> y + y (* ok *) - ;; -end - -module F1 = struct - open M1 - - let f r = - match r with - | { x; y } -> y + y - ;; -end - -(* fails *) - -module F2 = struct - open M1 - - let f r = - ignore (r : t); - match r with - | { x; y } -> y + y - ;; -end - -(* fails for -principal *) - -(* Use type information with modules*) -module M = struct - type t = { x : int } - type u = { x : bool } -end - -let f (r : M.t) = r.M.x - -(* ok *) -let f (r : M.t) = r.x - -(* warning *) -let f ({ x } : M.t) = x - -(* warning *) - -module M = struct - type t = - { x : int - ; y : int - } -end - -module N = struct - type u = - { x : bool - ; y : bool - } -end - -module OK = struct - open M - open N - - let f (r : M.t) = r.x -end - -module M = struct - type t = { x : int } - - module N = struct - type s = t = { x : int } - end - - type u = { x : bool } -end - -module OK = struct - open M.N - - let f (r : M.t) = r.x -end - -(* Use field information *) -module M = struct - type u = - { x : bool - ; y : int - ; z : char - } - - type t = - { x : int - ; y : bool - } -end - -module OK = struct - open M - - let f { x; z } = x, z -end - -(* ok *) -module F3 = struct - open M - - let r = { x = true; z = 'z' } -end - -(* fail for missing label *) - -module OK = struct - type u = - { x : int - ; y : bool - } - - type t = - { x : bool - ; y : int - ; z : char - } - - let r = { x = 3; y = true } -end - -(* ok *) - -(* Corner cases *) - -module F4 = struct - type foo = - { x : int - ; y : int - } - - type bar = { x : int } - - let b : bar = { x = 3; y = 4 } -end - -(* fail but don't warn *) - -module M = struct - type foo = - { x : int - ; y : int - } -end - -module N = struct - type bar = - { x : int - ; y : int - } -end - -let r = { M.x = 3; N.y = 4 } - -(* error: different definitions *) - -module MN = struct - include M - include N -end - -module NM = struct - include N - include M -end - -let r = { MN.x = 3; NM.y = 4 } - -(* error: type would change with order *) - -(* Lpw25 *) - -module M = struct - type foo = - { x : int - ; y : int - } - - type bar = - { x : int - ; y : int - ; z : int - } -end - -module F5 = struct - open M - - let f r = - ignore (r : foo); - { r with x = 2; z = 3 } - ;; -end - -module M = struct - include M - - type other = - { a : int - ; b : int - } -end - -module F6 = struct - open M - - let f r = - ignore (r : foo); - { r with x = 3; a = 4 } - ;; -end - -module F7 = struct - open M - - let r = { x = 1; y = 2 } - let r : other = { x = 1; y = 2 } -end - -module A = struct - type t = { x : int } -end - -module B = struct - type t = { x : int } -end - -let f (r : B.t) = r.A.x - -(* fail *) - -(* Spellchecking *) - -module F8 = struct - type t = - { x : int - ; yyy : int - } - - let a : t = { x = 1; yyz = 2 } -end - -(* PR#6004 *) - -type t = A -type s = A - -class f (_ : t) = object end -class g = f A - -(* ok *) - -class f (_ : 'a) (_ : 'a) = object end -class g = f (A : t) A - -(* warn with -principal *) - -(* PR#5980 *) - -module Shadow1 = struct - type t = { x : int } - - module M = struct - type s = { x : string } - end - - open M (* this open is unused, it isn't reported as shadowing 'x' *) - - let y : t = { x = 0 } -end - -module Shadow2 = struct - type t = { x : int } - - module M = struct - type s = { x : string } - end - - open M (* this open shadows label 'x' *) - - let y = { x = "" } -end - -(* PR#6235 *) - -module P6235 = struct - type t = { loc : string } - - type v = - { loc : string - ; x : int - } - - type u = [ `Key of t ] - - let f (u : u) = - match u with - | `Key { loc } -> loc - ;; -end - -(* Remove interaction between branches *) - -module P6235' = struct - type t = { loc : string } - - type v = - { loc : string - ; x : int - } - - type u = [ `Key of t ] - - let f = function - | (_ : u) when false -> "" - | `Key { loc } -> loc - ;; -end - -module Unused : sig end = struct - type unused = int -end - -module Unused_nonrec : sig end = struct - type nonrec used = int - type nonrec unused = used -end - -module Unused_rec : sig end = struct - type unused = A of unused -end - -module Unused_exception : sig end = struct - exception Nobody_uses_me -end - -module Unused_extension_constructor : sig - type t = .. -end = struct - type t = .. - type t += Nobody_uses_me -end - -module Unused_exception_outside_patterns : sig - val falsity : exn -> bool -end = struct - exception Nobody_constructs_me - - let falsity = function - | Nobody_constructs_me -> true - | _ -> false - ;; -end - -module Unused_extension_outside_patterns : sig - type t = .. - - val falsity : t -> bool -end = struct - type t = .. - type t += Nobody_constructs_me - - let falsity = function - | Nobody_constructs_me -> true - | _ -> false - ;; -end - -module Unused_private_exception : sig - type exn += private Private_exn -end = struct - exception Private_exn -end - -module Unused_private_extension : sig - type t = .. - type t += private Private_ext -end = struct - type t = .. - type t += Private_ext -end -;; - -for i = 10 downto 0 do - () -done - -type t = < foo : int [@foo] > - -let _ = [%foo: < foo : t > ] - -type foo += private A of int - -let f : 'a 'b 'c. < .. > = assert false - -let () = - let module M = (functor (T : sig end) -> struct end) (struct end) in - () -;; - -class c = - object - inherit (fun () -> object end [@wee] : object end) () - end - -let f = function - | (x [@wee]) -> () -;; - -let f = function - | '1' .. '9' | '1' .. '8' -> () - | 'a' .. 'z' -> () -;; - -let f = function - | [| x1; x2 |] -> () - | [||] -> () - | ([| x |] [@foo]) -> () - | _ -> () -;; - -let g = function - | { l = x } -> () - | ({ l1 = x; l2 = y } [@foo]) -> () - | { l1 = x; l2 = y; _ } -> () -;; - -let h = fun ?l:(p = 1) ?y:u ?(x = 3) -> 2 - -let _ = function - | a, s, ba1, ba2, ba3, bg -> - ignore - (Array.get x 1 + Array.get [||] 0 + Array.get [| 1 |] 1 + Array.get [| 1; 2 |] 2); - ignore [ String.get s 1; String.get "" 2; String.get "123" 3 ]; - ignore (ba1.{0} + ba2.{1, 2} + ba3.{3, 4, 5}) ignore bg.{1, 2, 3, 4} - | b, s, ba1, ba2, ba3, bg -> - y.(0) <- 1; - s.[1] <- 'c'; - ba1.{1} <- 2; - ba2.{1, 2} <- 3; - ba3.{1, 2, 3} <- 4; - bg.{1, 2, 3, 4, 5} <- 0 -;; - -let f (type t) () = - let exception F of t in - (); - let exception G of t in - (); - let exception E of t in - ( (fun x -> E x) - , function - | E _ -> print_endline "OK" - | _ -> print_endline "KO" ) -;; - -let inj1, proj1 = f () -let inj2, proj2 = f () -let () = proj1 (inj1 42) -let () = proj1 (inj2 42) -let _ = ~-1 - -class id = [%exp] -(* checkpoint *) - -(* Subtyping is "syntactic" *) -let _ = fun (x : < x : int >) y z -> (y :> 'a), (x :> 'a), (z :> 'a) - -(* - : (< x : int > as 'a) -> 'a -> 'a * 'a = <fun> *) - -class ['a] c () = - object - method f = (new c () : int c) - end - -and ['a] d () = - object - inherit ['a] c () - end - -(* PR#7329 Pattern open *) -let _ = - let module M = struct - type t = { x : int } - end - in - let f M.(x) = () in - let g M.{ x } = () in - let h = function - | M.[] | M.[ a ] | M.(a :: q) -> () - in - let i = function - | M.[||] | M.[| x |] -> true - | _ -> false - in - () -;; - -class ['a] c () = - object - constraint 'a = < .. > -> unit - method m = (fun x -> () : 'a) - end - -let f : type a'. a' = assert false -let foo : type a' b'. a' -> b' = fun a -> assert false -let foo : type t'. t' = fun (type t') -> (assert false : t') -let foo : 't. 't = fun (type t) -> (assert false : t) -let foo : type a' b' c' t. a' -> b' -> c' -> t = fun a b c -> assert false - -let f x = - x.contents - <- (print_string "coucou"; - x.contents) -;; - -let ( ~$ ) x = Some x -let g x = ~$(x.contents) -let ( ~$ ) x y = x, y -let g x y = ~$(x.contents) y.contents - -(* PR#7506: attributes on list tail *) - -let tail1 = [ 1; 2 ] [@hello] -let tail2 = 0 :: ([ 1; 2 ] [@hello]) -let tail3 = 0 :: ([] [@hello]) -let f ~l:(l [@foo]) = l -let test x y = (( + ) [@foo]) x y -let test x = (( ~- ) [@foo]) x -let test contents = { contents = contents [@foo] } - -class type t = object (_[@foo]) end - -class t = object (_ [@foo]) end - -let test f x = f ~x:(x [@foo]) - -let f = function - | (`A | `B) [@bar] | `C -> () -;; - -let f = function - | _ :: ((_ :: _) [@foo]) -> () - | _ -> () -;; - -function -| { contents = (contents [@foo]) } -> () -;; - -fun contents -> { contents = contents [@foo] };; - -(); -((); - ()) -[@foo] - -(* https://github.com/LexiFi/gen_js_api/issues/61 *) - -let () = foo##.bar := () - -(* "let open" in classes and class types *) - -class c = - let open M in - object - method f : t = x - end - -class type ct = - let open M in - object - method f : t - end - -(* M.(::) notation *) -module Exotic_list = struct - module Inner = struct - type ('a, 'b) t = - | [] - | ( :: ) of 'a * 'b * ('a, 'b) t - end - - let (Inner.( :: ) (x, y, Inner.[])) = Inner.( :: ) (1, "one", Inner.[]) -end - -(** Extended index operators *) -module Indexop = struct - module Def = struct - let ( .%[] ) = Hashtbl.find - let ( .%[]<- ) = Hashtbl.add - let ( .%() ) = Hashtbl.find - let ( .%()<- ) = Hashtbl.add - let ( .%{} ) = Hashtbl.find - let ( .%{}<- ) = Hashtbl.add - end - ;; - - let h = Hashtbl.create 17 in - h.Def.%["one"] <- 1; - h.Def.%("two") <- 2; - h.Def.%{"three"} <- 3 - - let x, y, z = Def.(h.%["one"], h.%("two"), h.%{"three"}) -end - -type t = | - -include struct - let%test_module "as" = - (module struct - let%expect_test "xx xx xxxxxx xxxxxxx xxxxxx xxxxxx xxxxxxxx xx xxxxx xxx xx xxxxx" = - () - ;; - end) - ;; -end -;; - -if fffffffffffffff aaaaa bb -then (if b then aaaaaaaaaaaaaaaa ffff) -else aaaaaaaaaaaa qqqqqqqqqqq - -include Base.Fn (** @open *) - -let ssmap - : (module MapT with type key = string and type data = string and type map = SSMap.map) - = - () -;; - -let ssmap - : (module MapT with type key = string and type data = string and type map = SSMap.map) - -> unit - = - () -;; - -let _ = - match x with - | A -> - [%expr - match y with - | e -> e] -;; - -let _ = - match x with - | A -> - [%expr - match y with - | e -> - (match e with - | x -> x)] -;; - -let _ = - List.map rows ~f:(fun row -> - Or_error.try_with (fun () -> fffffffffffffffffffffffff row)) -;; - -module type T = sig - (** @raise if not found. *) - val find : t -> key -> value option - - (** @param blablabla *) - val f : a_few:params -> with_long_names:to_break -> the_line:before_the_comment -> unit -end - -open! Core - -(** First documentation comment. *) -exception First_exception - -(** Second documentation comment. *) -exception Second_exception - -module M = struct - type t - [@@immediate] - (* ______________________________________ *) - [@@deriving variants, sexp_of] -end - -module type Basic3 = sig - type ('a, 'd, 'e) t - - val return : 'a -> ('a, _, _) t - val apply : ('a -> 'b, 'd, 'e) t -> ('a, 'd, 'e) t -> ('b, 'd, 'e) t - - val map - : [ `Define_using_apply - | `Custom of ('a, 'd, 'e) t -> f:('a -> 'b) -> ('b, 'd, 'e) t - ] -end - -let _ = - aa - (bbbbbbbbb - cccccccccccc - dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd) -;; - -let _ = - "_______________________________________________________ \ - _______________________________" -;; - -let _ = - [ very_long_function_name____________________ very_long_argument_name____________ ] -;; - -(* FIX: exceed 90 columns *) -let _ = - [%str - let () = very_long_function_name__________________ very_long_argument_name____________] -;; - -let _ = - { long_field_name = 9999999999999999999999999999999999999999999999999999999999999999999 - } -;; - -(* FIX: exceed 90 columns *) -let _ = - match () with - | _ -> - (match () with - | _ -> - long_function_name long_argument_name__________________________________________) -;; - -let _ = - aaaaaaa - (* __________________________________________________________________________________ *) - := bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb -;; - -let g = - f - ~x - (* this is a multiple-line-spanning - comment *) - ~y -;; - -let f = - very_long_function_name - ~x:very_long_variable_name - (* this is a multiple-line-spanning - comment *) - ~y -;; - -let _ = - match x with - | { y = - (* _____________________________________________________________________ *) - ( X _ | Y _ ) - } -> () -;; - -let _ = - match x with - | { y = - ( Z - (* _____________________________________________________________________ *) - | X _ - | Y _ ) - } -> () -;; - -type t = - [ `XXXX - (* __________________________________________________________________________________ *) - | `XXXX (* __________________________________________________________________ *) - | `XXXX (* _____________________________________________________ *) - | `XXXX (* ___________________________________________________ *) - | `XXXX (* ___________________________________________________ *) - | `XXXX (* ________________________________________________ *) - | `XXXX (* __________________________________________ *) - | `XXXX (* _________________________________________ *) - | `XXXX (* ______________________________________ *) - | `XXXX (* ____________________________________ *) - ] - -type t = - { field : ty - (* Here is some verbatim formatted text: - {v - starting at column 7 - v}*) - } - -module Intro_sort = struct - let foo_fooo_foooo fooo ~foooo m1 m2 m3 m4 m5 = - (* Fooooooooooooooooooooooooooo: - {v - 1--o-----o-----o--------------1 - | | | - 2--o-----|--o--|-----o--o-----2 - | | | | | - 3--------o--o--|--o--|--o-----3 - | | | - 4-----o--------o--o--|-----o--4 - | | | - 5-----o--------------o-----o--5 - v} *) - foooooooooo fooooo fooo; - foooooooooo fooooo fooo; - foooooooooo fooooo fooo - ;; -end - -let _ = - "_ _____________________ ___________ ________ _____________ ________ _____________ \ - _____\n\n\ - \ ___________________" -;; - -let nullsafe_optimistic_third_party_params_in_non_strict = - CLOpt.mk_bool - ~long:"nullsafe-optimistic-third-party-params-in-non-strict" - (* Turned on for compatibility reasons. Historically this is because - there was no actionable way to change third party annotations. Now - that we have such a support, this behavior should be reconsidered, - provided our tooling and error reporting is friendly enough to be - smoothly used by developers. *) - ~default:true - "Nullsafe: in this mode we treat non annotated third party method params as if they \ - were annotated as nullable." -;; - -let foo () = - if%bind - (* this is a medium length comment of some sort *) - this is a medium length expression of_some sort - then x - else y -;; - -let xxxxxx = - let%map (* _____________________________ - __________ *) () = yyyyyyyy in - { zzzzzzzzzzzzz } -;; - -let _ = - match x with - | _ - when f - ~f: - (function [@ocaml.warning (* ....................................... *) "-4"] - | _ -> .) -> y -;; - -let[@a - (* .............................................. ........................... .......................... ...................... *) - foo - (* ....................... *) - (* ................................. *) - (* ...................... *)] _ - = - match[@ocaml.warning (* ....................................... *) "-4"] - x [@attr (* .......................... .................. *) some_attr] - with - | _ - when f - ~f:(function[@ocaml.warning (* ....................................... *) "-4"] - | _ -> .) - ~f: - (function[@ocaml.warning - (* ....................................... *) - (* ....................................... *) - "foooooooooooooooooooooooooooo \ - fooooooooooooooooooooooooooooooooooooo"] - | _ -> .) - ~f: - (function[@ocaml.warning - (* ....................................... *) - let x = a - and y = b in - x + y] _ -> .) -> - y - [@attr - (* ... *) - (* ... *) - attr (* ... *)] -;; - -let x = - foo (`A b) ~f:(fun thing -> - something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping) -;; - -let x = - foo (`A `b) ~f:(fun thing -> - something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping) -;; - -let x = - foo [ A; B ] ~f:(fun thing -> - something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping) -;; - -let x = - foo [ [ A ]; B ] ~f:(fun thing -> - something that reaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaally needs wrapping) -;; - -let x = - f - ("A string _____________________" - ^ "Another string _____________" - ^ "Yet another string _________") -;; - -let x = - some_fun________________________________ - some_arg______________________________ - (fun param -> - do_something (); - do_something_else (); - return_this_value) -;; - -let x = - some_fun________________________________ - some_arg______________________________ - ~f:(fun param -> - do_something (); - do_something_else (); - return_this_value) -;; - -let x = - some_value - |> some_fun (fun x -> - do_something (); - do_something_else (); - return_this_value) -;; - -let x = - some_value - ^ some_fun (fun x -> - do_something (); - do_something_else (); - return_this_value) -;; - -let bind t ~f = - unfold_step - ~f:(function - | Sequence { state = seed; next }, rest -> - (match next seed with - | Done -> - (match rest with - | Sequence { state = seed; next } -> - (match next seed with - | Done -> Done - | Skip { state = s } -> - Skip { state = empty, Sequence { state = s; next } } - | Yield { value = a; state = s } -> - Skip { state = f a, Sequence { state = s; next } })) - | Skip { state = s } -> Skip { state = Sequence { state = s; next }, rest } - | Yield { value = a; state = s } -> - Yield { value = a; state = Sequence { state = s; next }, rest })) - ~init:(empty, t) -;; - -let () = - very_long_function_name - ~very_long_argument_label: - (fun - very_long_argument_name_one - very_long_argument_name_two - very_long_argument_name_three - -> ()) -;; - -let () = - ((one_mississippi, two_mississippi, three_mississippi, four_mississippi) - : Mississippi.t * Mississippi.t * Mississippi.t * Mississippi.t) -;; - -let _ = - ((match foo with - | Bar -> bar - | Baz -> baz) - : string) -;; - -let _ = - ((match foo with - | Bar -> bar - | Baz -> baz) - :> string) -;; - -let _ = - aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa - ~bbbbbbbbbbbbbbbbbbbbbbbbbbbb: - (fun - (_ : (ccccccccccccc * ddddddddddddddddddddddddddddd) eeee) -> FFFFFFFFF gg) - ~h -;; - -type t -[@@deriving - some_deriver_name -, another_deriver_name -, another_deriver_name -, another_deriver_name -, yet_another_such_name -, such_that_they_line_wrap] - -type t -[@@deriving - some_deriver_name - another_deriver_name - another_deriver_name - another_deriver_name - yet_another_such_name - such_that_they_line_wrap] - -let pat = - String.Search_pattern.create - (String.init len ~f:(function - | 0 -> '\n' - | n when n < len - 1 -> ' ' - | _ -> '*')) -;; - -type t = - { break_separators : [ `Before | `After ] - ; break_sequences : bool - ; break_string_literals : [ `Auto | `Never ] - (** How to potentially break string literals into new lines. *) - ; break_struct : bool - ; cases_exp_indent : int - ; cases_matching_exp_indent : [ `Normal | `Compact ] - } - -let rec collect_files - ~enable_outside_detected_project - ~root - ~segs - ~ignores - ~enables - ~files - = - match segs with - | [] | [ "" ] -> ignores, enables, files, None -;; - -let _ = - fooooooooooooooooooooooooooooooooooooooo - fooooooooooooooooooooooooooooooooooooooo - fooooooooooooooooooooooooooooooooooooooo - ~f:(fun (type a) foooooooooooooooooooooooooooooooooo : 'a -> - match fooooooooooooooooooooooooooooooooooooooo with - | Fooooooooooooooooooooooooooooooooooooooo -> x - | Fooooooooooooooooooooooooooooooooooooooo -> x) -;; - -let _ = - foo - |> List.map ~f:(fun x -> - do_something (); - do_something (); - do_something (); - do_something (); - do_something_else ()) -;; - -let _ = - foo - |> List.map ~f:(fun x -> - do_something (); - do_something (); - do_something (); - do_something (); - do_something_else ()) - |> bar -;; - -let _ = - foo - |> List.map - fooooooooooo - fooooooooooo - fooooooooooo - fooooooooooo - fooooooooooo - fooooooooooo - fooooooooooo - fooooooooooo -;; - -let _ = foo |> List.map (function A -> do_something ()) - -let _ = - foo - |> List.map (function - | A -> do_something () - | A -> do_something () - | A -> do_something () - | A -> do_something () - | A -> do_something_else ()) - |> bar -;; - -let _ = - foo - |> List.double_map - ~f1:(fun x -> - do_something (); - do_something (); - do_something (); - do_something (); - do_something_else ()) - ~f2:(fun x -> - do_something (); - do_something (); - do_something (); - do_something (); - do_something_else ()) - |> bar -;; - -module Stritem_attributes_indent : sig - val f : int -> int -> int -> int -> int - [@@cold] [@@inline never] [@@local never] [@@specialise never] - - external unsafe_memset - : t - -> pos:int - -> len:int - -> char - -> unit - = "bigstring_memset_stub" - [@@noalloc] -end = struct - let raise_length_mismatch name n1 n2 = - invalid_argf "length mismatch in %s: %d <> %d" name n1 n2 () - [@@cold] [@@inline never] [@@local never] [@@specialise never] - ;; - - external unsafe_memset - : t - -> pos:int - -> len:int - -> char - -> unit - = "bigstring_memset_stub" - [@@noalloc] -end - -let _ = - foo - $$ (match group with - | [] -> impossible "previous match" - | [ cmt ] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt) - $$ bar -;; - -let _ = - foo - $$ (try group with - | [] -> impossible "previous match" - | [ cmt ] -> fmt_cmt t conf cmt ~fmt_code $ maybe_newline ~next cmt) - $$ bar -;; - -let _ = - x == exp - || - match x with - | { pexp_desc = Pexp_constraint (e, _); _ } -> loop e - | _ -> false -;; - -let _ = - let module M = struct - include - (val foooooooooooooooooooooooooooooooooooooooo - : fooooooooooooooooooooooooooooooooooooooooo) - end - in - () -;; - -type action = - | In_out of [ `Impl | `Intf ] input * string option - (** Format input file (or [-] for stdin) of given kind to output file, - or stdout if None. *) - (* foo *) - | Inplace of [ `Impl | `Intf ] input list - (** Format in-place, overwriting input file(s). *) - -let%test_module "semantics" = - (module ( - struct - open Core - open Appendable_list - module Stable = Stable - end : - S)) -;; - -let _ = - Error - (`Foooooooooooooooooo - (name, Format.sprintf "expecting %S but got %S" Version.version value)) -;; - -let _ = - `Foooooooooooooooooo - (name, Format.sprintf "expecting %S but got %S" Version.version value) -;; - -let _ = - Foooooooooooooooooo - (name, Format.sprintf "expecting %S but got %S" Version.version value) -;; - -let (`Foooooooooooooooooo - (foooooooooooooo, foooooooooooooo, foooooooooooooo, foooooooooooooo)) - = - x -;; - -let (Foooooooooooooooooo - (foooooooooooooo, foooooooooooooo, foooooooooooooo, foooooooooooooo)) - = - x -;; - -let _ = - Foooooooooooooooooooo.foooooooooooooooooooo - foooooooooooooooooooo - foooooooooooooooooooo - (fun x -> function - | Foooooooooooooooooooo -> foooooooooooooooooooo - | Foooooooooooooooooooo -> foooooooooooooooooooo) -;; - -let _ = - Foooooooooooooooooooo.foooooooooooooooooooo - foooooooooooooooooooo - foooooooooooooooooooo - ~x:(fun x -> function - | Foooooooooooooooooooo -> foooooooooooooooooooo - | Foooooooooooooooooooo -> foooooooooooooooooooo) -;; - -let _ = - Foooooooooooooooooooo.foooooooooooooooooooo - foooooooooooooooooooo - foooooooooooooooooooo - (fun x -> - match foo with - | Foooooooooooooooooooo -> foooooooooooooooooooo - | Foooooooooooooooooooo -> foooooooooooooooooooo) -;; - -let _ = - Foooooooooooooooooooo.foooooooooooooooooooo - foooooooooooooooooooo - foooooooooooooooooooo - ~x:(fun x -> - match foo with - | Foooooooooooooooooooo -> foooooooooooooooooooo - | Foooooooooooooooooooo -> foooooooooooooooooooo) -;; - -let _ = - let x = x in - fun foooooooooooooooooo - foooooooooooooooooo - foooooooooooooooooo - foooooooooooooooooo - foooooooooooooooooo - foooooooooooooooooo -> () -;; - -module type For_let_syntax_local = - For_let_syntax_gen - with type ('a, 'b) fn := ('a[@local]) -> 'b - and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b - -type fooooooooooooooooooooooooooooooo = - ( fooooooooooooooooooooooooooooooo - , fooooooooooooooooooooooooooooooo ) - fooooooooooooooooooooooooooooooo - -val fooooooooooooooooooooooooooooooo - : ( fooooooooooooooooooooooooooooooo - , fooooooooooooooooooooooooooooooo ) - fooooooooooooooooooooooooooooooo - -(* *) - -(** - xxx -*) -include S1 -(** @inline *) - -type input = - { name : string - ; action : [ `Format | `Numeric of range ] - } - -let x = - fun [@foo] x -> - fun [@foo] y -> - object - method x = y - end -;; - -class x = - fun [@foo] x -> - fun [@foo] y -> - object - method x = y - end - -module M = - [%demo - module Foo = Bar - - type t] - -let _ = - Some - (fun fooooooooooooooooooooooooooooooo - fooooooooooooooooooooooooooooooo - fooooooooooooooooooooooooooooooo -> foo) -;; - -type t = - { xxxxxx : - t - (* _________________________________________________________________________ - ____________________________________________________________________ - ___________ *) - XXXXXXX.t - } - -module Test_gen - (For_tests : For_tests_gen) - (Tested : - S_gen with type 'a src := 'a For_tests.Src.t with type 'a dst := 'a For_tests.Dst.t) - (Tested : - S_gen - with type 'a src := 'a For_tests.Src.t - with type 'a dst := 'a For_tests.Dst.t - and type 'a dst := 'a For_tests.Dst.t - and type 'a dst := 'a For_tests.Dst.t) = -struct - open Tested - open For_tests -end - -type t = - { xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : - YYYYYYYYYYYYYYYYYYYYY.t - (* ____________________________________ *) - } - -(*{v - - foo - -v}*) - -(*$ - {| - f|} -*) - -type t = - { xxxxxxxxxxxxxxxxxxx : yyy - [@zzzzzzzzzzzzzzzzzzz - (* ________________________________ - ___ *) - _______] - } - -let _ = - match () with - (*$ Printf.(printf "\n | _ -> .\n;;\n") *) - | _ -> . -;; - -(*$*) - -(*$ "________________________" $*) - -(*$ - let open! Core in - () -*) -(*$*) - -(*$ - [%string - {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx -zzzzzzzzzzzzzzzzzzzzzzzzzzzz - |}] -*) -(*$*) - -(*$ - {| - f|} -*) - -let () = - match () with - | _ -> - (fun _ : _ -> - (match () with - | _ -> ())) - | _ -> () -;; - -(* ocp-indent-compat: Docked fun after apply only if on the same line. *) - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo:(fun foo -> bar) -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo:(fun foo -> bar) - ~fooooooooooooooooooooooooooooooo -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo:(fun foo -> - match bar with - | Some _ -> foo - | None -> baz) -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo (fun foo -> bar) -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo (fun foo -> - match bar with - | Some _ -> foo - | None -> baz) -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo - ~fooooooooooooooooooooooooooooooo - (fun foo -> - match bar with - | Some _ -> foo - | None -> baz) -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooofooooooooooooooooooooooooooooooofoooooooooo - (fun foo -> - match bar with - | Some _ -> foo - | None -> baz) -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> foooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo (function foo -> bar) -;; - -let _ = - fooooooooooooooooooooooooooooooo - |> fooooooooooooooooooooooooooooooo ~fooooooooooooooooooooooooooooooo (function - | Some _ -> foo - | None -> baz) -;; - -(* *) - -(*$ (* *) *) - -(** xxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx - xxxx] xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx [xxxxxxx] *) - -(* Hand-aligned comment - . - . *) - -(* First line is indented more - . - . *) - -module type M = sig - val imported_sets_of_closures_table - : Simple_value_approx.function_declarations option - Set_of_closures_id.Tbl.fooooooooooooooooooooooooo -end - -(*$ let _ = [ x (* *); y ] *) - -let _ = - { foo = - (fun _ -> function - | _ -> - let _ = 42 in - () - | () -> ()) - } -;; - -let _ = - match () with - | _ -> - f - >>= (function - | `Fooooooooooooooooooooooooooooooooooooooo -> 1 - | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> 2) -;; - -let _ = - match () with - | _ -> - f - >>= (function - | `Fooooooooooooooooooooooooooooooooooooooo -> 1 - | `Baaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaar -> 2) - >>= foo -;; - -let exists t key = - S.Tree.kind t.tree (path key) - >|= function - | Some `Contents -> Ok (Some `Value) - | Some `Node -> Ok (Some `Dictionary) - | None -> Ok None -;; - -let _ = if x then 42 (* dummy *) else y -let _ = if x then 42 (* dummy *) else if y then z else w - -let _ = - if x - then - fun _ -> true - (* foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo *) - else f -;; - -let _ = - match ids_queue with - | Some q -> - (* this is more efficient than a linear scan of [ids] *) - fun id -> not (Ident.HashQueue.mem q id) - | None -> fun id -> not (List.mem ~equal:Ident.equal ids id) -;; - -type callbacks = - { html_debug_new_node_session_f : - 'a. - ?kind:[ `ComputePre | `ExecNode | `ExecNodeNarrowing | `WTO ] - -> pp_name:(Format.formatter -> unit) - -> Procdesc.Node.t - -> f:(unit -> 'a) - -> 'a - } diff --git a/test/passing/tests/js_source.ml.ocp-opts b/test/passing/tests/js_source.ml.ocp-opts deleted file mode 100644 index fd5859fc88..0000000000 --- a/test/passing/tests/js_source.ml.ocp-opts +++ /dev/null @@ -1,2 +0,0 @@ ---config -JaneStreet diff --git a/test/passing/tests/js_source.ml.opts b/test/passing/tests/js_source.ml.opts index 5d8d795624..d4626ceab5 100644 --- a/test/passing/tests/js_source.ml.opts +++ b/test/passing/tests/js_source.ml.opts @@ -1,2 +1 @@ --max-iters=3 ---profile=janestreet diff --git a/test/passing/tests/line_directives.ml.ref b/test/passing/tests/line_directives.ml.ref deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/need_format.ml.ref b/test/passing/tests/need_format.ml.ref deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/polytypes-default.ml.opts b/test/passing/tests/polytypes-default.ml.opts deleted file mode 100644 index 5e416d59f3..0000000000 --- a/test/passing/tests/polytypes-default.ml.opts +++ /dev/null @@ -1 +0,0 @@ ---profile=default diff --git a/test/passing/tests/polytypes-janestreet.ml.err b/test/passing/tests/polytypes-janestreet.ml.err deleted file mode 100644 index dec5c05f9b..0000000000 --- a/test/passing/tests/polytypes-janestreet.ml.err +++ /dev/null @@ -1 +0,0 @@ -Warning: tests/polytypes.ml:48 exceeds the margin diff --git a/test/passing/tests/polytypes-janestreet.ml.opts b/test/passing/tests/polytypes-janestreet.ml.opts deleted file mode 100644 index 37c78e5d93..0000000000 --- a/test/passing/tests/polytypes-janestreet.ml.opts +++ /dev/null @@ -1 +0,0 @@ ---profile=janestreet diff --git a/test/passing/tests/print_config.ml b/test/passing/tests/print_config.ml deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/print_config.ml.deps b/test/passing/tests/print_config.ml.deps deleted file mode 100644 index e0e0c6b879..0000000000 --- a/test/passing/tests/print_config.ml.deps +++ /dev/null @@ -1,2 +0,0 @@ -tests/dir1/dir2/.ocamlformat -tests/dir1/dir2/print_config.ml diff --git a/test/passing/tests/print_config.ml.enabled-if b/test/passing/tests/print_config.ml.enabled-if deleted file mode 100644 index 4092744d6f..0000000000 --- a/test/passing/tests/print_config.ml.enabled-if +++ /dev/null @@ -1 +0,0 @@ -(<> %{os_type} Win32) diff --git a/test/passing/tests/print_config.ml.err b/test/passing/tests/print_config.ml.err deleted file mode 100644 index f09df3a14a..0000000000 --- a/test/passing/tests/print_config.ml.err +++ /dev/null @@ -1,71 +0,0 @@ -comment-check=true -debug=false -disable=false -margin-check=true (command line) -max-iters=2 (environment variable) -ocaml-version=4.13.0 (file tests/.ocamlformat:7) -quiet=false -disable-conf-attrs=false -version-check=true -assignment-operator=end-line (profile ocamlformat (file tests/.ocamlformat:1)) -break-before-in=fit-or-vertical (profile ocamlformat (file tests/.ocamlformat:1)) -break-cases=fit (file tests/.ocamlformat:2) -break-collection-expressions=fit-or-vertical (profile ocamlformat (file tests/.ocamlformat:1)) -break-colon=after (profile ocamlformat (file tests/.ocamlformat:1)) -break-fun-decl=wrap (profile ocamlformat (file tests/.ocamlformat:1)) -break-fun-sig=wrap (profile ocamlformat (file tests/.ocamlformat:1)) -break-infix=wrap (profile ocamlformat (file tests/.ocamlformat:1)) -break-infix-before-func=true (profile ocamlformat (file tests/.ocamlformat:1)) -break-separators=before (profile ocamlformat (file tests/.ocamlformat:1)) -break-sequences=false (profile ocamlformat (file tests/.ocamlformat:1)) -break-string-literals=auto (profile ocamlformat (file tests/.ocamlformat:1)) -break-struct=force (profile ocamlformat (file tests/.ocamlformat:1)) -cases-exp-indent=4 (profile ocamlformat (file tests/.ocamlformat:1)) -cases-matching-exp-indent=compact (profile ocamlformat (file tests/.ocamlformat:1)) -disambiguate-non-breaking-match=false (profile ocamlformat (file tests/.ocamlformat:1)) -doc-comments=before-except-val (profile ocamlformat (file tests/.ocamlformat:1)) -doc-comments-padding=2 (profile ocamlformat (file tests/.ocamlformat:1)) -doc-comments-tag-only=default (profile ocamlformat (file tests/.ocamlformat:1)) -dock-collection-brackets=false (profile ocamlformat (file tests/.ocamlformat:1)) -exp-grouping=parens (profile ocamlformat (file tests/.ocamlformat:1)) -extension-indent=2 (profile ocamlformat (file tests/.ocamlformat:1)) -field-space=tight (profile ocamlformat (file tests/.ocamlformat:1)) -function-indent=2 (profile ocamlformat (file tests/.ocamlformat:1)) -function-indent-nested=never (profile ocamlformat (file tests/.ocamlformat:1)) -if-then-else=compact (profile ocamlformat (file tests/.ocamlformat:1)) -indent-after-in=0 (profile ocamlformat (file tests/.ocamlformat:1)) -indicate-multiline-delimiters=space (profile ocamlformat (file tests/.ocamlformat:1)) -indicate-nested-or-patterns=space (profile ocamlformat (file tests/.ocamlformat:1)) -infix-precedence=indent (profile ocamlformat (file tests/.ocamlformat:1)) -leading-nested-match-parens=false (profile ocamlformat (file tests/.ocamlformat:1)) -let-and=compact (profile ocamlformat (file tests/.ocamlformat:1)) -let-binding-indent=2 (profile ocamlformat (file tests/.ocamlformat:1)) -let-binding-deindent-fun=true (profile ocamlformat (file tests/.ocamlformat:1)) -let-binding-spacing=compact (profile ocamlformat (file tests/.ocamlformat:1)) -let-module=compact (profile ocamlformat (file tests/.ocamlformat:1)) -line-endings=lf (profile ocamlformat (file tests/.ocamlformat:1)) -margin=77 (file tests/.ocamlformat:3) -match-indent=0 (profile ocamlformat (file tests/.ocamlformat:1)) -match-indent-nested=never (profile ocamlformat (file tests/.ocamlformat:1)) -max-indent=68 (profile ocamlformat (file tests/.ocamlformat:1)) -module-item-spacing=sparse (file tests/dir1/dir2/.ocamlformat:1) -nested-match=wrap (profile ocamlformat (file tests/.ocamlformat:1)) -ocp-indent-compat=false (profile ocamlformat (file tests/.ocamlformat:1)) -parens-ite=false (profile ocamlformat (file tests/.ocamlformat:1)) -parens-tuple=always (profile ocamlformat (file tests/.ocamlformat:1)) -parens-tuple-patterns=multi-line-only (profile ocamlformat (file tests/.ocamlformat:1)) -parse-docstrings=true (file tests/.ocamlformat:4) -parse-toplevel-phrases=false (profile ocamlformat (file tests/.ocamlformat:1)) -sequence-blank-line=compact (profile ocamlformat (file tests/.ocamlformat:1)) -sequence-style=separator (profile ocamlformat (file tests/.ocamlformat:1)) -single-case=compact (profile ocamlformat (file tests/.ocamlformat:1)) -space-around-arrays=false (profile ocamlformat (file tests/.ocamlformat:1)) -space-around-lists=false (profile ocamlformat (file tests/.ocamlformat:1)) -space-around-records=false (profile ocamlformat (file tests/.ocamlformat:1)) -space-around-variants=false (profile ocamlformat (file tests/.ocamlformat:1)) -stritem-extension-indent=0 (profile ocamlformat (file tests/.ocamlformat:1)) -type-decl=compact (profile ocamlformat (file tests/.ocamlformat:1)) -type-decl-indent=2 (profile ocamlformat (file tests/.ocamlformat:1)) -wrap-comments=true (file tests/.ocamlformat:5) -wrap-fun-args=true (profile ocamlformat (file tests/.ocamlformat:1)) -profile=ocamlformat (file tests/.ocamlformat:1) diff --git a/test/passing/tests/print_config.ml.opts b/test/passing/tests/print_config.ml.opts deleted file mode 100644 index 9b6f3d0741..0000000000 --- a/test/passing/tests/print_config.ml.opts +++ /dev/null @@ -1,3 +0,0 @@ -%{dep:tests/dir1/dir2/print_config.ml} ---print-config ---config=max-iters=2 diff --git a/test/passing/tests/print_config.ml.ref b/test/passing/tests/print_config.ml.ref deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/profiles.ml.opts b/test/passing/tests/profiles.ml.opts index 15665ebc55..c8a6a509fb 100644 --- a/test/passing/tests/profiles.ml.opts +++ b/test/passing/tests/profiles.ml.opts @@ -1,3 +1,2 @@ --config=margin=20 ---profile=janestreet --module-item-spacing=sparse diff --git a/test/passing/tests/profiles2.ml.opts b/test/passing/tests/profiles2.ml.opts deleted file mode 100644 index 37c78e5d93..0000000000 --- a/test/passing/tests/profiles2.ml.opts +++ /dev/null @@ -1 +0,0 @@ ---profile=janestreet diff --git a/test/passing/tests/record-default.ml.err b/test/passing/tests/record-default.ml.err deleted file mode 100644 index 5fc3706467..0000000000 --- a/test/passing/tests/record-default.ml.err +++ /dev/null @@ -1,2 +0,0 @@ -Warning: tests/record.ml:8 exceeds the margin -Warning: tests/record.ml:16 exceeds the margin diff --git a/test/passing/tests/record-default.ml.opts b/test/passing/tests/record-default.ml.opts deleted file mode 100644 index b230a8c4e7..0000000000 --- a/test/passing/tests/record-default.ml.opts +++ /dev/null @@ -1,2 +0,0 @@ ---profile=default ---max-iter=3 diff --git a/test/passing/tests/record_punning-js.ml.opts b/test/passing/tests/record_punning-js.ml.opts deleted file mode 100644 index b374761303..0000000000 --- a/test/passing/tests/record_punning-js.ml.opts +++ /dev/null @@ -1 +0,0 @@ ---profile=janestreet --max-iter=4 diff --git a/test/passing/tests/reformat_string.ml.opts b/test/passing/tests/reformat_string.ml.opts index d90b68b116..a2f04741b8 100644 --- a/test/passing/tests/reformat_string.ml.opts +++ b/test/passing/tests/reformat_string.ml.opts @@ -1 +1 @@ ---max-iter=2 +--max-iter=3 diff --git a/test/passing/tests/source-conventional.ml.err b/test/passing/tests/source-conventional.ml.err deleted file mode 100644 index 957d18a985..0000000000 --- a/test/passing/tests/source-conventional.ml.err +++ /dev/null @@ -1,5 +0,0 @@ -Warning: tests/source.ml:925 exceeds the margin -Warning: tests/source.ml:1000 exceeds the margin -Warning: tests/source.ml:6620 exceeds the margin -Warning: tests/source.ml:7078 exceeds the margin -Warning: tests/source.ml:8655 exceeds the margin diff --git a/test/passing/tests/source-conventional.ml.opts b/test/passing/tests/source-conventional.ml.opts deleted file mode 100644 index bfae9aa9ca..0000000000 --- a/test/passing/tests/source-conventional.ml.opts +++ /dev/null @@ -1 +0,0 @@ ---profile=default --max-iters=3 diff --git a/test/passing/tests/verbose1.ml b/test/passing/tests/verbose1.ml deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/verbose1.ml.enabled-if b/test/passing/tests/verbose1.ml.enabled-if deleted file mode 100644 index 4092744d6f..0000000000 --- a/test/passing/tests/verbose1.ml.enabled-if +++ /dev/null @@ -1 +0,0 @@ -(<> %{os_type} Win32) diff --git a/test/passing/tests/verbose1.ml.err b/test/passing/tests/verbose1.ml.err deleted file mode 100644 index a63ed578b3..0000000000 --- a/test/passing/tests/verbose1.ml.err +++ /dev/null @@ -1,71 +0,0 @@ -comment-check=true -debug=false -disable=false -margin-check=true (command line) -max-iters=2 (file tests/.ocamlformat:6) -ocaml-version=4.13.0 (file tests/.ocamlformat:7) -quiet=false -disable-conf-attrs=false -version-check=true -assignment-operator=end-line (profile ocamlformat (file tests/.ocamlformat:1)) -break-before-in=fit-or-vertical (profile ocamlformat (file tests/.ocamlformat:1)) -break-cases=fit (file tests/.ocamlformat:2) -break-collection-expressions=fit-or-vertical (profile ocamlformat (file tests/.ocamlformat:1)) -break-colon=after (profile ocamlformat (file tests/.ocamlformat:1)) -break-fun-decl=wrap (profile ocamlformat (file tests/.ocamlformat:1)) -break-fun-sig=wrap (profile ocamlformat (file tests/.ocamlformat:1)) -break-infix=wrap (profile ocamlformat (file tests/.ocamlformat:1)) -break-infix-before-func=true (profile ocamlformat (file tests/.ocamlformat:1)) -break-separators=before (profile ocamlformat (file tests/.ocamlformat:1)) -break-sequences=false (profile ocamlformat (file tests/.ocamlformat:1)) -break-string-literals=auto (profile ocamlformat (file tests/.ocamlformat:1)) -break-struct=force (profile ocamlformat (file tests/.ocamlformat:1)) -cases-exp-indent=4 (profile ocamlformat (file tests/.ocamlformat:1)) -cases-matching-exp-indent=compact (profile ocamlformat (file tests/.ocamlformat:1)) -disambiguate-non-breaking-match=false (profile ocamlformat (file tests/.ocamlformat:1)) -doc-comments=before (command line) -doc-comments-padding=2 (profile ocamlformat (file tests/.ocamlformat:1)) -doc-comments-tag-only=default (profile ocamlformat (file tests/.ocamlformat:1)) -dock-collection-brackets=false (profile ocamlformat (file tests/.ocamlformat:1)) -exp-grouping=parens (profile ocamlformat (file tests/.ocamlformat:1)) -extension-indent=2 (profile ocamlformat (file tests/.ocamlformat:1)) -field-space=tight (profile ocamlformat (file tests/.ocamlformat:1)) -function-indent=2 (profile ocamlformat (file tests/.ocamlformat:1)) -function-indent-nested=never (profile ocamlformat (file tests/.ocamlformat:1)) -if-then-else=compact (profile ocamlformat (file tests/.ocamlformat:1)) -indent-after-in=0 (profile ocamlformat (file tests/.ocamlformat:1)) -indicate-multiline-delimiters=space (profile ocamlformat (file tests/.ocamlformat:1)) -indicate-nested-or-patterns=space (profile ocamlformat (file tests/.ocamlformat:1)) -infix-precedence=indent (profile ocamlformat (file tests/.ocamlformat:1)) -leading-nested-match-parens=false (profile ocamlformat (file tests/.ocamlformat:1)) -let-and=compact (profile ocamlformat (file tests/.ocamlformat:1)) -let-binding-indent=2 (profile ocamlformat (file tests/.ocamlformat:1)) -let-binding-deindent-fun=true (profile ocamlformat (file tests/.ocamlformat:1)) -let-binding-spacing=compact (profile ocamlformat (file tests/.ocamlformat:1)) -let-module=compact (profile ocamlformat (file tests/.ocamlformat:1)) -line-endings=lf (profile ocamlformat (file tests/.ocamlformat:1)) -margin=77 (file tests/.ocamlformat:3) -match-indent=0 (profile ocamlformat (file tests/.ocamlformat:1)) -match-indent-nested=never (profile ocamlformat (file tests/.ocamlformat:1)) -max-indent=68 (profile ocamlformat (file tests/.ocamlformat:1)) -module-item-spacing=sparse (profile ocamlformat (file tests/.ocamlformat:1)) -nested-match=wrap (profile ocamlformat (file tests/.ocamlformat:1)) -ocp-indent-compat=false (profile ocamlformat (file tests/.ocamlformat:1)) -parens-ite=false (profile ocamlformat (file tests/.ocamlformat:1)) -parens-tuple=always (profile ocamlformat (file tests/.ocamlformat:1)) -parens-tuple-patterns=multi-line-only (profile ocamlformat (file tests/.ocamlformat:1)) -parse-docstrings=true (file tests/.ocamlformat:4) -parse-toplevel-phrases=false (profile ocamlformat (file tests/.ocamlformat:1)) -sequence-blank-line=compact (profile ocamlformat (file tests/.ocamlformat:1)) -sequence-style=separator (profile ocamlformat (file tests/.ocamlformat:1)) -single-case=compact (profile ocamlformat (file tests/.ocamlformat:1)) -space-around-arrays=false (profile ocamlformat (file tests/.ocamlformat:1)) -space-around-lists=false (profile ocamlformat (file tests/.ocamlformat:1)) -space-around-records=false (profile ocamlformat (file tests/.ocamlformat:1)) -space-around-variants=false (profile ocamlformat (file tests/.ocamlformat:1)) -stritem-extension-indent=0 (profile ocamlformat (file tests/.ocamlformat:1)) -type-decl=compact (profile ocamlformat (file tests/.ocamlformat:1)) -type-decl-indent=2 (profile ocamlformat (file tests/.ocamlformat:1)) -wrap-comments=true (file tests/.ocamlformat:5) -wrap-fun-args=true (profile ocamlformat (file tests/.ocamlformat:1)) -profile=ocamlformat (file tests/.ocamlformat:1) diff --git a/test/passing/tests/verbose1.ml.opts b/test/passing/tests/verbose1.ml.opts deleted file mode 100644 index 985a4168ba..0000000000 --- a/test/passing/tests/verbose1.ml.opts +++ /dev/null @@ -1,3 +0,0 @@ ---print-config ---doc-comments=before ---config=doc-comments=before diff --git a/test/passing/tests/verbose1.ml.ref b/test/passing/tests/verbose1.ml.ref deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/test/passing/tests/wrap_comments.ml.opts b/test/passing/tests/wrap_comments.ml.opts index 41c8e97a1d..d4626ceab5 100644 --- a/test/passing/tests/wrap_comments.ml.opts +++ b/test/passing/tests/wrap_comments.ml.opts @@ -1,2 +1 @@ ---profile=ocamlformat --max-iters=3