hphp/hack/src/hh_single_decl_rupro.ml

   1 (*
   2  * Copyright (c) Facebook, Inc. and its affiliates.
   3  *
   4  * This source code is licensed under the MIT license found in the
   5  * LICENSE file in the "hack" directory of this source tree.
   6  *
   7  *)
   8
   9 open Hh_prelude
  10 open Direct_decl_parser
  11
  12 let popt
  13     ~auto_namespace_map
  14     ~enable_xhp_class_modifier
  15     ~disable_xhp_element_mangling
  16     ~disable_enum_classes
  17     ~enable_enum_supertyping
  18     ~interpret_soft_types_as_like_types
  19     ~everything_sdt =
  20   let enable_enum_classes = not disable_enum_classes in
  21   let po = ParserOptions.default in
  22   let po =
  23     ParserOptions.with_disable_xhp_element_mangling
  24       po
  25       disable_xhp_element_mangling
  26   in
  27   let po = ParserOptions.with_auto_namespace_map po auto_namespace_map in
  28   let po =
  29     ParserOptions.with_enable_xhp_class_modifier po enable_xhp_class_modifier
  30   in
  31   let po = ParserOptions.with_enable_enum_classes po enable_enum_classes in
  32   let po =
  33     ParserOptions.with_enable_enum_supertyping po enable_enum_supertyping
  34   in
  35   let po =
  36     ParserOptions.with_interpret_soft_types_as_like_types
  37       po
  38       interpret_soft_types_as_like_types
  39   in
  40   let po = ParserOptions.with_everything_sdt po everything_sdt in
  41   po
  42
  43 let init popt : Provider_context.t =
  44   let (_handle : SharedMem.handle) =
  45     SharedMem.init ~num_workers:0 SharedMem.default_config
  46   in
  47   let tcopt =
  48     {
  49       popt with
  50       GlobalOptions.tco_shallow_class_decl = false;
  51       tco_higher_kinded_types = true;
  52       tco_use_direct_decl_parser = true;
  53     }
  54   in
  55   let ctx =
  56     Provider_context.empty_for_tool
  57       ~popt
  58       ~tcopt
  59       ~backend:Provider_backend.Shared_memory
  60       ~deps_mode:(Typing_deps_mode.InMemoryMode None)
  61   in
  62
  63   (* Push local stacks here so we don't include shared memory in our timing. *)
  64   File_provider.local_changes_push_sharedmem_stack ();
  65   Decl_provider.local_changes_push_sharedmem_stack ();
  66   Shallow_classes_provider.local_changes_push_sharedmem_stack ();
  67   Linearization_provider.local_changes_push_sharedmem_stack ();
  68
  69   ctx
  70
  71 let direct_decl_parse ctx fn text =
  72   let popt = Provider_context.get_popt ctx in
  73   let opts = DeclParserOptions.from_parser_options popt in
  74   let parsed_file = Direct_decl_parser.parse_decls opts fn text in
  75   parsed_file.pf_decls
  76
  77 let print_diff ~expected_name ~actual_name ~expected_contents ~actual_contents =
  78   Tempfile.with_real_tempdir @@ fun dir ->
  79   let temp_dir = Path.to_string dir in
  80   let expected = Caml.Filename.temp_file ~temp_dir "expected" ".txt" in
  81   let actual = Caml.Filename.temp_file ~temp_dir "actual" ".txt" in
  82   Disk.write_file ~file:expected ~contents:(expected_contents ^ "\n");
  83   Disk.write_file ~file:actual ~contents:(actual_contents ^ "\n");
  84   Ppxlib_print_diff.print
  85     ~diff_command:
  86       (Printf.sprintf
  87          "diff -U9999 --label '%s' --label '%s'"
  88          expected_name
  89          actual_name)
  90     ~file1:expected
  91     ~file2:actual
  92     ()
  93
  94 let compare_folded ctx rupro_decls filename text =
  95   let class_names =
  96     direct_decl_parse ctx filename text
  97     |> List.rev_filter_map ~f:(function
  98            | (name, Shallow_decl_defs.Class _) -> Some name
  99            | _ -> None)
 100   in
 101   let ocaml_folded_classes =
 102     List.map class_names ~f:(fun cid ->
 103         Decl_provider.declare_folded_class_in_file_FOR_TESTS_ONLY
 104           ctx
 105           filename
 106           cid)
 107   in
 108   let rupro_folded_classes = Relative_path.Map.find rupro_decls filename in
 109   let show_folded_decls decls =
 110     decls
 111     |> List.map ~f:Decl_folded_class_rupro.show_decl_class_type
 112     |> String.concat ~sep:"\n"
 113   in
 114   let folded = show_folded_decls ocaml_folded_classes in
 115   let rupro_folded = show_folded_decls rupro_folded_classes in
 116   let matched = String.equal folded rupro_folded in
 117   if matched then
 118     Printf.eprintf "%s\n%!" rupro_folded
 119   else
 120     print_diff
 121       ~expected_name:"ocaml"
 122       ~actual_name:"rupro"
 123       ~expected_contents:folded
 124       ~actual_contents:rupro_folded;
 125   matched
 126
 127 let () =
 128   let usage = Printf.sprintf "Usage: %s [OPTIONS] filename\n" Sys.argv.(0) in
 129   let usage_and_exit () =
 130     prerr_endline usage;
 131     exit 1
 132   in
 133   let file = ref None in
 134   let set_file f =
 135     match !file with
 136     | None -> file := Some f
 137     | Some _ -> usage_and_exit ()
 138   in
 139   let auto_namespace_map = ref [] in
 140   let enable_xhp_class_modifier = ref false in
 141   let disable_xhp_element_mangling = ref false in
 142   let disable_enum_classes = ref false in
 143   let disallow_static_memoized = ref false in
 144   let enable_enum_supertyping = ref false in
 145   let interpret_soft_types_as_like_types = ref false in
 146   let everything_sdt = ref false in
 147   let ignored_flag flag = (flag, Arg.Unit (fun _ -> ()), "(ignored)") in
 148   let ignored_arg flag = (flag, Arg.String (fun _ -> ()), "(ignored)") in
 149   Arg.parse
 150     [
 151       ( "--auto-namespace-map",
 152         Arg.String
 153           (fun m ->
 154             auto_namespace_map := ServerConfig.convert_auto_namespace_to_map m),
 155         "Namespace aliases" );
 156       ( "--enable-xhp-class-modifier",
 157         Arg.Set enable_xhp_class_modifier,
 158         "Enable the XHP class modifier, xhp class name {} will define an xhp class."
 159       );
 160       ( "--disable-xhp-element-mangling",
 161         Arg.Set disable_xhp_element_mangling,
 162         "." );
 163       ( "--disable-enum-classes",
 164         Arg.Set disable_enum_classes,
 165         "Disable the enum classes extension." );
 166       ( "--disallow-static-memoized",
 167         Arg.Set disallow_static_memoized,
 168         " Disallow static memoized methods on non-final methods" );
 169       ( "--enable-enum-supertyping",
 170         Arg.Set enable_enum_supertyping,
 171         "Enable the enum supertyping extension." );
 172       ( "--interpret-soft-types-as-like-types",
 173         Arg.Set interpret_soft_types_as_like_types,
 174         "Interpret <<__Soft>> type hints as like types" );
 175       ("--everything-sdt", Arg.Set everything_sdt, "Classes have SDT");
 176       (* The following options do not affect the direct decl parser and can be ignored
 177          (they are used by hh_single_type_check, and we run hh_single_decl over all of
 178          the typecheck test cases). *)
 179       ignored_arg "--enable-global-write-check";
 180       ignored_arg "--enable-global-write-check-functions";
 181       ignored_flag "--abstract-static-props";
 182       ignored_arg "--allowed-decl-fixme-codes";
 183       ignored_arg "--allowed-fixme-codes-strict";
 184       ignored_flag "--allow-toplevel-requires";
 185       ignored_flag "--check-xhp-attribute";
 186       ignored_flag "--complex-coercion";
 187       ignored_flag "--const-attribute";
 188       ignored_flag "--const-static-props";
 189       ignored_flag "--disable-hh-ignore-error";
 190       ignored_flag "--disable-modes";
 191       ignored_flag "--disable-partially-abstract-typeconsts";
 192       ignored_flag "--disable-unset-class-const";
 193       ignored_flag "--disable-xhp-children-declarations";
 194       ignored_flag "--disallow-discarded-nullable-awaitables";
 195       ignored_flag "--disallow-fun-and-cls-meth-pseudo-funcs";
 196       ignored_flag "--disallow-func-ptrs-in-constants";
 197       ignored_flag "--disallow-invalid-arraykey-constraint";
 198       ignored_flag "--disallow-php-lambdas";
 199       ignored_flag "--disallow-silence";
 200       ignored_flag "--disallow-trait-reuse";
 201       ignored_flag "--enable-class-level-where-clauses";
 202       ignored_flag "--enable-higher-kinded-types";
 203       ignored_flag "--enable-systemlib-annotations";
 204       ignored_flag "--forbid_nullable_cast";
 205       ( "--hh-log-level",
 206         Arg.Tuple [Arg.String (fun _ -> ()); Arg.String (fun _ -> ())],
 207         "(ignored)" );
 208       ignored_flag "--like-casts";
 209       ignored_flag "--like-type-hints";
 210       ignored_flag "--like-types-all";
 211       ignored_flag "--method-call-inference";
 212       ignored_flag "--no-builtins";
 213       ignored_flag "--no-strict-contexts";
 214       ignored_flag "--report-pos-from-reason";
 215       ignored_arg "--simple-pessimize";
 216       ignored_arg "--timeout";
 217       ignored_flag "--union-intersection-type-hints";
 218       ignored_flag "--enable-strict-string-concat-interp";
 219       ignored_arg "--extra-builtin";
 220       ignored_flag "--disallow-inst-meth";
 221       ignored_flag "--ignore-unsafe-cast";
 222       ignored_flag "--inc-dec-new-code";
 223       ignored_flag "--math-new-code";
 224       ignored_flag "--disallow-partially-abstract-typeconst-definitions";
 225       ignored_flag "--typeconst-concrete-concrete-error";
 226       ignored_flag "--enable-strict-const-semantics";
 227       ignored_arg "--meth-caller-only-public-visibility";
 228       ignored_flag "--require-extends-implements-ancestors";
 229       ignored_flag "--strict-value-equality";
 230       ignored_flag "--enable-sealed-subclasses";
 231       ignored_flag "--enable-sound-dynamic-type";
 232       ignored_flag "--pessimise-builtins";
 233       ignored_arg "--explicit-consistent-constructors";
 234     ]
 235     set_file
 236     usage;
 237   match !file with
 238   | None -> usage_and_exit ()
 239   | Some file ->
 240     let file = Path.make file in
 241     let auto_namespace_map = !auto_namespace_map in
 242     let enable_xhp_class_modifier = !enable_xhp_class_modifier in
 243     let disable_xhp_element_mangling = !disable_xhp_element_mangling in
 244     let disable_enum_classes = !disable_enum_classes in
 245     let enable_enum_supertyping = !enable_enum_supertyping in
 246     let interpret_soft_types_as_like_types =
 247       !interpret_soft_types_as_like_types
 248     in
 249     let everything_sdt = !everything_sdt in
 250     let popt =
 251       popt
 252         ~auto_namespace_map
 253         ~enable_xhp_class_modifier
 254         ~disable_xhp_element_mangling
 255         ~disable_enum_classes
 256         ~enable_enum_supertyping
 257         ~interpret_soft_types_as_like_types
 258         ~everything_sdt
 259     in
 260     let tco_experimental_features =
 261       if !disallow_static_memoized then
 262         SSet.singleton GlobalOptions.tco_experimental_disallow_static_memoized
 263       else
 264         SSet.empty
 265     in
 266     let popt = { popt with GlobalOptions.tco_experimental_features } in
 267     (* Temporarily set the root to the location of the test file so that
 268        Multifile will strip the dirname prefix. *)
 269     Relative_path.(set_path_prefix Root (Path.dirname file));
 270     let file = Relative_path.(create Root (Path.to_string file)) in
 271     let files =
 272       Multifile.file_to_file_list file
 273       |> List.map ~f:(fun (file, contents) ->
 274              (Relative_path.to_absolute file, contents))
 275     in
 276     Tempfile.with_real_tempdir @@ fun tmpdir ->
 277     (* Set the Relative_path root to the tmpdir. *)
 278     Relative_path.(set_path_prefix Root tmpdir);
 279     (* Write the files to a tempdir so that rupro can read them, then map
 280        them to relative paths. *)
 281     let files =
 282       List.map files ~f:(fun (filename, contents) ->
 283           let tmpdir = Path.to_string tmpdir in
 284           let basename = Filename.basename filename in
 285           let filename = Filename.concat tmpdir basename in
 286           Disk.write_file ~file:filename ~contents;
 287           (Relative_path.(create Root filename), contents))
 288     in
 289     let ctx = init popt in
 290     let iter_files f =
 291       let num_files = List.length files in
 292       let (all_matched, _) =
 293         List.fold
 294           files
 295           ~init:(true, true)
 296           ~f:(fun (matched, is_first) (filename, contents) ->
 297             (* All output is printed to stderr because that's the output
 298                channel Ppxlib_print_diff prints to. *)
 299             if not is_first then Printf.eprintf "\n%!";
 300             if num_files > 1 then
 301               Printf.eprintf
 302                 "File %s\n%!"
 303                 (Relative_path.storage_to_string filename);
 304             let matched =
 305               Provider_utils.respect_but_quarantine_unsaved_changes
 306                 ~ctx
 307                 ~f:(fun () -> f filename contents)
 308               && matched
 309             in
 310             (matched, false))
 311       in
 312       all_matched
 313     in
 314     let all_matched =
 315       let files = List.map files ~f:fst in
 316       (* Compute OCaml folded decls *)
 317       List.iter files ~f:(fun filename ->
 318           Errors.run_in_context filename Errors.Decl (fun () ->
 319               Decl.make_env ~sh:SharedMem.Uses ctx filename));
 320       (* Compute rupro folded decls *)
 321       let rupro_decls =
 322         Decl_folded_class_rupro.fold_classes_in_files
 323           ~root:(Path.to_string tmpdir)
 324           files
 325       in
 326       iter_files (compare_folded ctx rupro_decls)
 327     in
 328     if all_matched then
 329       Printf.eprintf "\nThey matched!\n%!"
 330     else
 331       exit 1