hphp/hack/src/hh_single_decl.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     ~enable_enum_classes
  17     ~array_unification =
  18   let po = ParserOptions.default in
  19   let po =
  20     ParserOptions.with_disable_xhp_element_mangling
  21       po
  22       disable_xhp_element_mangling
  23   in
  24   let po = ParserOptions.with_auto_namespace_map po auto_namespace_map in
  25   let po =
  26     ParserOptions.with_enable_xhp_class_modifier po enable_xhp_class_modifier
  27   in
  28   let po = ParserOptions.with_enable_enum_classes po enable_enum_classes in
  29   let po = ParserOptions.with_array_unification po array_unification in
  30   po
  31
  32 let init root popt : Provider_context.t =
  33   Relative_path.(set_path_prefix Root root);
  34   let (_handle : SharedMem.handle) =
  35     SharedMem.init ~num_workers:0 SharedMem.default_config
  36   in
  37   let tcopt =
  38     {
  39       popt with
  40       GlobalOptions.tco_shallow_class_decl = true;
  41       tco_higher_kinded_types = true;
  42     }
  43   in
  44   (* TODO(hverr): Figure out 64-bit *)
  45   let ctx =
  46     Provider_context.empty_for_tool
  47       ~popt
  48       ~tcopt
  49       ~backend:Provider_backend.Shared_memory
  50       ~deps_mode:Typing_deps_mode.SQLiteMode
  51   in
  52
  53   (* Push local stacks here so we don't include shared memory in our timing. *)
  54   File_provider.local_changes_push_sharedmem_stack ();
  55   Decl_provider.local_changes_push_sharedmem_stack ();
  56   Shallow_classes_provider.local_changes_push_sharedmem_stack ();
  57   Linearization_provider.local_changes_push_sharedmem_stack ();
  58
  59   ctx
  60
  61 let rec shallow_declare_ast ctx decls prog =
  62   List.fold prog ~init:decls ~f:(fun decls def ->
  63       let open Aast in
  64       match def with
  65       | Namespace (_, prog) -> shallow_declare_ast ctx decls prog
  66       | NamespaceUse _ -> decls
  67       | SetNamespaceEnv _ -> decls
  68       | FileAttributes _ -> decls
  69       | Fun f ->
  70         let (name, decl) = Decl_nast.fun_naming_and_decl ctx f in
  71         (name, Shallow_decl_defs.Fun decl) :: decls
  72       | Class c ->
  73         let decl = Shallow_classes_provider.decl ctx c in
  74         let (_, name) = decl.Shallow_decl_defs.sc_name in
  75         (name, Shallow_decl_defs.Class decl) :: decls
  76       | RecordDef rd ->
  77         let (name, decl) = Decl_nast.record_def_naming_and_decl ctx rd in
  78         (name, Shallow_decl_defs.Record decl) :: decls
  79       | Typedef typedef ->
  80         let (name, decl) = Decl_nast.typedef_naming_and_decl ctx typedef in
  81         (name, Shallow_decl_defs.Typedef decl) :: decls
  82       | Stmt _ -> decls
  83       | Constant cst ->
  84         let (name, ty) = Decl_nast.const_naming_and_decl ctx cst in
  85         let decl = Typing_defs.{ cd_pos = fst cst.cst_name; cd_type = ty } in
  86         (name, Shallow_decl_defs.Const decl) :: decls)
  87
  88 let compare_decls ctx fn text =
  89   let (ctx, _entry) =
  90     Provider_context.(
  91       add_or_overwrite_entry_contents ~ctx ~path:fn ~contents:text)
  92   in
  93   let ast = Ast_provider.get_ast ctx fn in
  94   let legacy_decls = shallow_declare_ast ctx [] ast in
  95   let legacy_decls_str = show_decls (List.rev legacy_decls) ^ "\n" in
  96   let popt = Provider_context.get_popt ctx in
  97   let auto_namespace_map = ParserOptions.auto_namespace_map popt in
  98   let disable_xhp_element_mangling =
  99     ParserOptions.disable_xhp_element_mangling popt
 100   in
 101   let array_unification = ParserOptions.array_unification popt in
 102   let decls =
 103     parse_decls_ffi
 104       disable_xhp_element_mangling
 105       array_unification
 106       fn
 107       text
 108       auto_namespace_map
 109   in
 110   let decls_str = show_decls (List.rev decls) ^ "\n" in
 111   let matched = String.equal decls_str legacy_decls_str in
 112   if matched then
 113     Printf.eprintf "%s%!" decls_str
 114   else
 115     Tempfile.with_real_tempdir (fun dir ->
 116         let temp_dir = Path.to_string dir in
 117         let expected =
 118           Caml.Filename.temp_file ~temp_dir "expected_decls" ".txt"
 119         in
 120         let actual = Caml.Filename.temp_file ~temp_dir "actual_decls" ".txt" in
 121         Disk.write_file ~file:expected ~contents:legacy_decls_str;
 122         Disk.write_file ~file:actual ~contents:decls_str;
 123         Ppxlib_print_diff.print
 124           ~diff_command:"diff -U9999 --label legacy --label 'direct decl'"
 125           ~file1:expected
 126           ~file2:actual
 127           ());
 128   matched
 129
 130 type modes = CompareDirectDeclParser
 131
 132 let () =
 133   let usage =
 134     Printf.sprintf "Usage: %s [OPTIONS] mode filename\n" Sys.argv.(0)
 135   in
 136   let usage_and_exit () =
 137     prerr_endline usage;
 138     exit 1
 139   in
 140   let mode = ref None in
 141   let set_mode m () =
 142     match !mode with
 143     | None -> mode := Some m
 144     | Some _ -> usage_and_exit ()
 145   in
 146   let file = ref None in
 147   let set_file f =
 148     match !file with
 149     | None -> file := Some f
 150     | Some _ -> usage_and_exit ()
 151   in
 152   let skip_if_errors = ref false in
 153   let expect_extension = ref ".exp" in
 154   let set_expect_extension s = expect_extension := s in
 155   let auto_namespace_map = ref [] in
 156   let enable_xhp_class_modifier = ref false in
 157   let disable_xhp_element_mangling = ref false in
 158   let enable_enum_classes = ref false in
 159   let array_unification = ref false in
 160   let ignored_flag flag = (flag, Arg.Unit (fun _ -> ()), "(ignored)") in
 161   let ignored_arg flag = (flag, Arg.String (fun _ -> ()), "(ignored)") in
 162   Arg.parse
 163     [
 164       ( "--compare-direct-decl-parser",
 165         Arg.Unit (set_mode CompareDirectDeclParser),
 166         "(mode) Runs the direct decl parser against the FFP -> naming -> decl pipeline and compares their output"
 167       );
 168       ( "--skip-if-errors",
 169         Arg.Set skip_if_errors,
 170         "Skip comparison if the corresponding .exp file has errors" );
 171       ( "--expect-extension",
 172         Arg.String set_expect_extension,
 173         "The extension with which the output of the legacy pipeline should be written"
 174       );
 175       ( "--auto-namespace-map",
 176         Arg.String
 177           (fun m ->
 178             auto_namespace_map := ServerConfig.convert_auto_namespace_to_map m),
 179         "Namespace aliases" );
 180       ( "--enable-xhp-class-modifier",
 181         Arg.Set enable_xhp_class_modifier,
 182         "Enable the XHP class modifier, xhp class name {} will define an xhp class."
 183       );
 184       ( "--disable-xhp-element-mangling",
 185         Arg.Set disable_xhp_element_mangling,
 186         "." );
 187       ( "--enable-enum-classes",
 188         Arg.Set enable_enum_classes,
 189         "Enable the enum classes extension." );
 190       ( "--array-unification",
 191         Arg.Set array_unification,
 192         "Treat varray as vec, darray as dict, TODO varray_or_darray as vec_or_dict"
 193       );
 194       (* The following options do not affect the direct decl parser and can be ignored
 195          (they are used by hh_single_type_check, and we run hh_single_decl over all of
 196          the typecheck test cases). *)
 197       ignored_flag "--abstract-static-props";
 198       ignored_arg "--allowed-decl-fixme-codes";
 199       ignored_arg "--allowed-fixme-codes-strict";
 200       ignored_flag "--allow-toplevel-requires";
 201       ignored_flag "--check-xhp-attribute";
 202       ignored_flag "--complex-coercion";
 203       ignored_flag "--const-attribute";
 204       ignored_flag "--const-static-props";
 205       ignored_flag "--disable-hh-ignore-error";
 206       ignored_flag "--disable-modes";
 207       ignored_flag "--disable-partially-abstract-typeconsts";
 208       ignored_flag "--disable-unset-class-const";
 209       ignored_flag "--disable-xhp-children-declarations";
 210       ignored_flag "--disallow-discarded-nullable-awaitables";
 211       ignored_flag "--disallow-fun-and-cls-meth-pseudo-funcs";
 212       ignored_flag "--disallow-func-ptrs-in-constants";
 213       ignored_flag "--disallow-invalid-arraykey-constraint";
 214       ignored_flag "--disallow-php-lambdas";
 215       ignored_flag "--disallow-silence";
 216       ignored_flag "--disallow-trait-reuse";
 217       ignored_flag "--enable-class-level-where-clauses";
 218       ignored_flag "--enable-higher-kinded-types";
 219       ignored_flag "--enable-systemlib-annotations";
 220       ignored_flag "--forbid_nullable_cast";
 221       ( "--hh-log-level",
 222         Arg.Tuple [Arg.String (fun _ -> ()); Arg.String (fun _ -> ())],
 223         "(ignored)" );
 224       ignored_flag "--like-casts";
 225       ignored_flag "--like-type-hints";
 226       ignored_flag "--like-types-all";
 227       ignored_flag "--method-call-inference";
 228       ignored_flag "--no-builtins";
 229       ignored_flag "--no-strict-contexts";
 230       ignored_flag "--report-pos-from-reason";
 231       ignored_arg "--simple-pessimize";
 232       ignored_arg "--timeout";
 233       ignored_flag "--union-intersection-type-hints";
 234     ]
 235     set_file
 236     usage;
 237   match !mode with
 238   | None -> usage_and_exit ()
 239   | Some CompareDirectDeclParser ->
 240     begin
 241       match !file with
 242       | None -> usage_and_exit ()
 243       | Some file ->
 244         let () =
 245           if
 246             !skip_if_errors
 247             && not
 248                @@ String_utils.is_substring
 249                     "No errors"
 250                     (RealDisk.cat (file ^ ".exp"))
 251           then begin
 252             print_endline "Skipping because input file has errors";
 253             exit 0
 254           end
 255         in
 256         let file = Path.make file in
 257         let auto_namespace_map = !auto_namespace_map in
 258         let enable_xhp_class_modifier = !enable_xhp_class_modifier in
 259         let disable_xhp_element_mangling = !disable_xhp_element_mangling in
 260         let enable_enum_classes = !enable_enum_classes in
 261         let array_unification = !array_unification in
 262         let popt =
 263           popt
 264             ~auto_namespace_map
 265             ~enable_xhp_class_modifier
 266             ~disable_xhp_element_mangling
 267             ~enable_enum_classes
 268             ~array_unification
 269         in
 270         let ctx = init (Path.dirname file) popt in
 271         let file = Relative_path.(create Root (Path.to_string file)) in
 272         let files = Multifile.file_to_file_list file in
 273         let num_files = List.length files in
 274         let (all_matched, _) =
 275           List.fold
 276             files
 277             ~init:(true, true)
 278             ~f:(fun (matched, is_first) (filename, contents) ->
 279               (* All output is printed to stderr because that's the output
 280                  channel Ppxlib_print_diff prints to. *)
 281               if not is_first then Printf.eprintf "\n%!";
 282               (* Multifile turns the path into an absolute path instead of a
 283                  relative one. Turn it back into a relative path. *)
 284               let filename =
 285                 Relative_path.(create Root (Relative_path.to_absolute filename))
 286               in
 287               if num_files > 1 then
 288                 Printf.eprintf
 289                   "File %s\n%!"
 290                   (Relative_path.storage_to_string filename);
 291               let matched =
 292                 Provider_utils.respect_but_quarantine_unsaved_changes
 293                   ~ctx
 294                   ~f:(fun () -> compare_decls ctx filename contents)
 295                 && matched
 296               in
 297               (matched, false))
 298         in
 299         if all_matched then
 300           Printf.eprintf "\nThey matched!\n%!"
 301         else
 302           exit 1
 303     end