diff --git a/src/compiler/retyper.ml b/src/compiler/retyper.ml index f0d3332347e..be81ecf3dc6 100644 --- a/src/compiler/retyper.ml +++ b/src/compiler/retyper.ml @@ -74,13 +74,13 @@ let pair_class_field rctx ctx cctx fctx cf cff p = remove_class_field_flag cf CfPostProcessed; ) -let pair_classes rctx context_init c d p = +let pair_classes rctx c d p = let rctx = {rctx with print_stack = (Printf.sprintf "[Class %s]" (s_type_path c.cl_path)) :: rctx.print_stack } in c.cl_restore(); (* TODO: What do we do with build macros? *) - let cctx = create_class_context c context_init p in + let cctx = create_class_context c p in let ctx = create_typer_context_for_class rctx.typer cctx p in let _ = let rctx = {rctx with @@ -180,14 +180,14 @@ let pair_typedefs ctx rctx td d = ignore (disable_typeloading rctx ctx (fun () -> Typeload.load_complex_type ctx false d.d_data)); [] -let pair_abstracts ctx rctx context_init a d p = +let pair_abstracts ctx rctx a d p = let rctx = {rctx with print_stack = (Printf.sprintf "[Abstract %s]" (s_type_path a.a_path)) :: rctx.print_stack } in match a.a_impl with | Some c -> c.cl_restore(); - let cctx = create_class_context c context_init p in + let cctx = create_class_context c p in let ctx = create_typer_context_for_class rctx.typer cctx p in let fl = List.map (fun cff -> let cff = TypeloadFields.transform_abstract_field2 ctx a cff in @@ -218,7 +218,6 @@ let attempt_retyping ctx m p = print_stack = [Printf.sprintf "[Module %s]" (s_type_path m.m_path)]; } in (* log rctx 0 (Printf.sprintf "Retyping module %s" (s_type_path m.m_path)); *) - let context_init = new TypeloadFields.context_init in let find_type name = try List.find (fun t -> snd (t_infos t).mt_path = name) ctx.m.curmod.m_types with Not_found -> @@ -230,11 +229,11 @@ let attempt_retyping ctx m p = | (d,p) :: decls -> begin match d with | EImport (path,mode) -> - ImportHandling.init_import ctx context_init path mode p; + ImportHandling.init_import ctx path mode p; ImportHandling.commit_import ctx path mode p; loop acc decls | EUsing path -> - ImportHandling.init_using ctx context_init path p; + ImportHandling.init_using ctx path p; loop acc decls | EClass c -> let mt = find_type (fst c.d_name) in @@ -257,18 +256,17 @@ let attempt_retyping ctx m p = let pairs = loop [] decls in let fl = List.map (fun (d,mt) -> match d,mt with | EClass d,TClassDecl c -> - pair_classes rctx context_init c d p + pair_classes rctx c d p | EEnum d,TEnumDecl en -> pair_enums ctx rctx en d | ETypedef d,TTypeDecl td -> pair_typedefs ctx rctx td d | EAbstract d,TAbstractDecl a -> - pair_abstracts ctx rctx context_init a d p + pair_abstracts ctx rctx a d p | _ -> fail rctx "?" ) pairs in (* If we get here we know that the everything is ok. *) - delay ctx PConnectField (fun () -> context_init#run); List.iter (fun fl -> List.iter (fun f -> f()) fl ) fl; diff --git a/src/context/display/displayEmitter.ml b/src/context/display/displayEmitter.ml index 5be7520b789..4dad066c021 100644 --- a/src/context/display/displayEmitter.ml +++ b/src/context/display/displayEmitter.ml @@ -18,6 +18,17 @@ let symbol_of_module_type = function | TTypeDecl td -> SKTypedef td | TAbstractDecl a -> SKAbstract a +let display_alias ctx name t p = match ctx.com.display.dms_kind with + | DMDefinition | DMTypeDefinition -> + raise_positions [p]; + | DMUsage _ | DMImplementation -> + ReferencePosition.set (name,p,SKOther) + | DMHover -> + let ct = CompletionType.from_type (get_import_status ctx) t in + raise_hover (make_ci_literal name (t,ct)) None p + | _ -> + () + let display_module_type ctx mt p = match ctx.com.display.dms_kind with | DMDefinition | DMTypeDefinition -> begin match mt with diff --git a/src/context/display/displayTexpr.ml b/src/context/display/displayTexpr.ml index da6efa99e54..8ec3f3adcb4 100644 --- a/src/context/display/displayTexpr.ml +++ b/src/context/display/displayTexpr.ml @@ -57,8 +57,7 @@ let find_abstract_by_position decls p = loop decls let actually_check_display_field ctx c cff p = - let context_init = new TypeloadFields.context_init in - let cctx = TypeloadFields.create_class_context c context_init p in + let cctx = TypeloadFields.create_class_context c p in let ctx = TypeloadFields.create_typer_context_for_class ctx cctx p in let cff = TypeloadFields.transform_field (ctx,cctx) c cff (ref []) (pos cff.cff_name) in let display_modifier = Typeload.check_field_access ctx cff in diff --git a/src/context/display/displayToplevel.ml b/src/context/display/displayToplevel.ml index 19d1eab527e..86bbcff00fd 100644 --- a/src/context/display/displayToplevel.ml +++ b/src/context/display/displayToplevel.ml @@ -187,7 +187,7 @@ module CollectionContext = struct Shadowed with Not_found -> let check_wildcard () = - List.exists (fun (sl,_) -> (sl,snd path) = path) ctx.ctx.m.wildcard_packages + List.exists (fun (sl,_) -> (sl,snd path) = path) ctx.ctx.m.import_resolution#extract_wildcard_packages in if is_import || (fst path = []) || check_wildcard () then Imported else Unimported @@ -377,7 +377,7 @@ let collect ctx tk with_type sort = () in List.iter enum_ctors ctx.m.curmod.m_types; - List.iter enum_ctors (List.map fst ctx.m.module_imports); + List.iter enum_ctors (List.map fst ctx.m.import_resolution#extract_type_imports); (* enum constructors of expected type *) begin match with_type with @@ -414,7 +414,7 @@ let collect ctx tk with_type sort = | _ -> raise Not_found with Not_found -> () - ) ctx.m.module_globals; + ) ctx.m.import_resolution#extract_field_imports; (* literals *) add (make_ci_literal "null" (tpair t_dynamic)) (Some "null"); @@ -459,7 +459,7 @@ let collect ctx tk with_type sort = List.iter add_type ctx.m.curmod.m_types; (* module imports *) - List.iter add_type (List.rev_map fst ctx.m.module_imports); (* reverse! *) + List.iter add_type (List.rev_map fst ctx.m.import_resolution#extract_type_imports); (* reverse! *) (* types from files *) let cs = ctx.com.cs in diff --git a/src/context/display/importHandling.ml b/src/context/display/importHandling.ml index 32b0d24cd94..1986d5b8976 100644 --- a/src/context/display/importHandling.ml +++ b/src/context/display/importHandling.ml @@ -5,6 +5,7 @@ open Common open Type open Error open Typecore +open Resolution type import_display_kind = | IDKPackage of string list @@ -61,7 +62,7 @@ let commit_import ctx path mode p = ctx.m.import_statements <- (path,mode) :: ctx.m.import_statements; if Filename.basename p.pfile <> "import.hx" then add_import_position ctx p path -let init_import ctx context_init path mode p = +let init_import ctx path mode p = let rec loop acc = function | x :: l when is_lower_ident (fst x) -> loop (x::acc) l | rest -> List.rev acc, rest @@ -71,7 +72,7 @@ let init_import ctx context_init path mode p = | [] -> (match mode with | IAll -> - ctx.m.wildcard_packages <- (List.map fst pack,p) :: ctx.m.wildcard_packages + ctx.m.import_resolution#add (wildcard_package_resolution (List.map fst pack) p) | _ -> (match List.rev path with (* p spans `import |` (to the display position), so we take the pmax here *) @@ -82,7 +83,7 @@ let init_import ctx context_init path mode p = let p_type = punion p1 p2 in let md = ctx.g.do_load_module ctx (List.map fst pack,tname) p_type in let types = md.m_types in - let no_private (t,_) = not (t_infos t).mt_private in + let not_private mt = not (t_infos mt).mt_private in let error_private p = raise_typing_error "Importing private declarations from a module is not allowed" p in let chk_private t p = if ctx.m.curmod != (t_infos t).mt_module && (t_infos t).mt_private then error_private p in let has_name name t = snd (t_infos t).mt_path = name in @@ -109,66 +110,70 @@ let init_import ctx context_init path mode p = chk_private t p_type; t in - let rebind t name p = + let check_alias mt name pname = if not (name.[0] >= 'A' && name.[0] <= 'Z') then - raise_typing_error "Type aliases must start with an uppercase letter" p; - let _, _, f = ctx.g.do_build_instance ctx t p_type in - (* create a temp private typedef, does not register it in module *) - let t_path = (fst md.m_path @ ["_" ^ snd md.m_path],name) in - let t_type = f (extract_param_types (t_infos t).mt_params) in - let mt = TTypeDecl {(mk_typedef ctx.m.curmod t_path p p t_type) with - t_private = true; - t_params = (t_infos t).mt_params - } in - if ctx.is_display_file && DisplayPosition.display_position#enclosed_in p then - DisplayEmitter.display_module_type ctx mt p; - mt + raise_typing_error "Type aliases must start with an uppercase letter" pname; + if ctx.is_display_file && DisplayPosition.display_position#enclosed_in pname then + DisplayEmitter.display_alias ctx name (type_of_module_type mt) pname; in let add_static_init t name s = - let name = (match name with None -> s | Some (n,_) -> n) in match resolve_typedef t with - | TClassDecl c | TAbstractDecl {a_impl = Some c} -> + | TClassDecl c -> ignore(c.cl_build()); - ignore(PMap.find s c.cl_statics); - ctx.m.module_globals <- PMap.add name (TClassDecl c,s,p) ctx.m.module_globals - | TEnumDecl e -> - ignore(PMap.find s e.e_constrs); - ctx.m.module_globals <- PMap.add name (TEnumDecl e,s,p) ctx.m.module_globals + let cf = PMap.find s c.cl_statics in + static_field_resolution c cf name p + | TAbstractDecl ({a_impl = Some c} as a) -> + ignore(c.cl_build()); + let cf = PMap.find s c.cl_statics in + static_abstract_field_resolution a c cf name p + | TEnumDecl en -> + let ef = PMap.find s en.e_constrs in + enum_constructor_resolution en ef name p | _ -> raise Not_found in + let add_lazy_resolution f = + ctx.m.import_resolution#add (lazy_resolution f) + in (match mode with | INormal | IAsName _ -> let name = (match mode with IAsName n -> Some n | _ -> None) in (match rest with | [] -> - (match name with + begin match name with | None -> - ctx.m.module_imports <- List.filter no_private (List.map (fun t -> t,p) types) @ ctx.m.module_imports; + List.iter (fun mt -> + if not_private mt then + ctx.m.import_resolution#add (module_type_resolution mt None p) + ) (List.rev types); Option.may (fun c -> - context_init#add (fun () -> - ignore(c.cl_build()); - List.iter (fun cf -> - if has_class_field_flag cf CfPublic then - ctx.m.module_globals <- PMap.add cf.cf_name (TClassDecl c,cf.cf_name,p) ctx.m.module_globals - ) c.cl_ordered_statics - ); + ctx.m.import_resolution#add (class_statics_resolution c p) ) md.m_statics | Some(newname,pname) -> - ctx.m.module_imports <- (rebind (get_type tname) newname pname,p) :: ctx.m.module_imports); + let mt = get_type tname in + check_alias mt newname pname; + ctx.m.import_resolution#add (module_type_resolution mt (Some newname) p2) + end | [tsub,p2] -> let pu = punion p1 p2 in (try let tsub = List.find (has_name tsub) types in chk_private tsub pu; - ctx.m.module_imports <- ((match name with None -> tsub | Some(n,pname) -> rebind tsub n pname),p) :: ctx.m.module_imports + let alias = match name with + | None -> + None + | Some(name,pname) -> + check_alias tsub name pname; + Some name + in + ctx.m.import_resolution#add (module_type_resolution tsub alias p2); with Not_found -> (* this might be a static property, wait later to check *) let find_main_type_static () = try let tmain = find_type tname in begin try - add_static_init tmain name tsub + Some (add_static_init tmain (Option.map fst name) tsub) with Not_found -> let parent,target_kind,candidates = match resolve_typedef tmain with | TClassDecl c -> @@ -189,13 +194,13 @@ let init_import ctx context_init path mode p = (* TODO: cleaner way to get module fields? *) PMap.foldi (fun n _ acc -> n :: acc) (try (Option.get md.m_statics).cl_statics with | _ -> PMap.empty) [] in - - display_error ctx.com (StringError.string_error tsub candidates (parent ^ " has no " ^ target_kind ^ " " ^ tsub)) p + display_error ctx.com (StringError.string_error tsub candidates (parent ^ " has no " ^ target_kind ^ " " ^ tsub)) p; + None end with Not_found -> fail_usefully tsub p in - context_init#add (fun() -> + add_lazy_resolution (fun() -> match md.m_statics with | Some c -> (try @@ -208,8 +213,7 @@ let init_import ctx context_init path mode p = if not (has_class_field_flag cf CfPublic) then error_private p else - let imported_name = match name with None -> tsub | Some (n,pname) -> n in - ctx.m.module_globals <- PMap.add imported_name (TClassDecl c,tsub,p) ctx.m.module_globals; + Some (static_field_resolution c cf (Option.map fst name) p) else loop rest in @@ -225,11 +229,12 @@ let init_import ctx context_init path mode p = | [] -> () | (n,p) :: _ -> raise_typing_error ("Unexpected " ^ n) p); let tsub = get_type tsub in - context_init#add (fun() -> + add_lazy_resolution (fun() -> try - add_static_init tsub name fname + Some (add_static_init tsub (Option.map fst name) fname) with Not_found -> - display_error ctx.com (s_type_path (t_infos tsub).mt_path ^ " has no field " ^ fname) (punion p p3) + display_error ctx.com (s_type_path (t_infos tsub).mt_path ^ " has no field " ^ fname) (punion p p3); + None ); ) | IAll -> @@ -238,14 +243,13 @@ let init_import ctx context_init path mode p = | [tsub,_] -> get_type tsub | _ :: (n,p) :: _ -> raise_typing_error ("Unexpected " ^ n) p ) in - context_init#add (fun() -> + add_lazy_resolution (fun() -> match resolve_typedef t with | TClassDecl c | TAbstractDecl {a_impl = Some c} -> - ignore(c.cl_build()); - PMap.iter (fun _ cf -> if not (has_meta Meta.NoImportGlobal cf.cf_meta) then ctx.m.module_globals <- PMap.add cf.cf_name (TClassDecl c,cf.cf_name,p) ctx.m.module_globals) c.cl_statics - | TEnumDecl e -> - PMap.iter (fun _ c -> if not (has_meta Meta.NoImportGlobal c.ef_meta) then ctx.m.module_globals <- PMap.add c.ef_name (TEnumDecl e,c.ef_name,p) ctx.m.module_globals) e.e_constrs + Some (class_statics_resolution c p) + | TEnumDecl en -> + Some (enum_statics_resolution en p) | _ -> raise_typing_error "No statics to import from this type" p ) @@ -270,7 +274,6 @@ let handle_using ctx path p = let t = ctx.g.do_load_type_def ctx p t in [t] ) in - (* delay the using since we need to resolve typedefs *) let filter_classes types = let rec loop acc types = match types with | td :: l -> @@ -286,8 +289,11 @@ let handle_using ctx path p = in types,filter_classes -let init_using ctx context_init path p = +let init_using ctx path p = let types,filter_classes = handle_using ctx path p in (* do the import first *) - ctx.m.module_imports <- (List.map (fun t -> t,p) types) @ ctx.m.module_imports; - context_init#add (fun() -> ctx.m.module_using <- filter_classes types @ ctx.m.module_using) + List.iter (fun mt -> + ctx.m.import_resolution#add (module_type_resolution mt None p) + ) (List.rev types); + (* delay the using since we need to resolve typedefs *) + delay_late ctx PConnectField (fun () -> ctx.m.module_using <- filter_classes types @ ctx.m.module_using) diff --git a/src/context/resolution.ml b/src/context/resolution.ml new file mode 100644 index 00000000000..dd4f7c022e8 --- /dev/null +++ b/src/context/resolution.ml @@ -0,0 +1,248 @@ +open Globals +open Type + +type resolution_kind = + | RTypeImport of string* module_type + | RClassFieldImport of string * tclass * tclass_field + | RAbstractFieldImport of string * tabstract * tclass * tclass_field + | REnumConstructorImport of string * tenum * tenum_field + | RWildcardPackage of string list + | RClassStatics of tclass + | REnumStatics of tenum + | RLazy of (unit -> resolution option) + +and resolution = { + r_kind : resolution_kind; + r_pos : pos; +} + +let mk_resolution kind p = { + r_kind = kind; + r_pos = p; +} + +let lazy_resolution f = + mk_resolution (RLazy f) null_pos + +let module_type_resolution mt alias p = + mk_resolution (RTypeImport((Option.default (t_name mt) alias),mt)) p + +let static_field_resolution c cf alias p = + mk_resolution (RClassFieldImport((Option.default cf.cf_name alias),c,cf)) p + +let static_abstract_field_resolution a c cf alias p = + mk_resolution (RAbstractFieldImport((Option.default cf.cf_name alias),a,c,cf)) p + +let enum_constructor_resolution en ef alias p = + mk_resolution (REnumConstructorImport((Option.default ef.ef_name alias),en,ef)) p + +let class_statics_resolution c p = + mk_resolution (RClassStatics c) p + +let enum_statics_resolution en p = + mk_resolution (REnumStatics en) p + +let wildcard_package_resolution sl p = + mk_resolution (RWildcardPackage sl) p + +let as_importable_static c cf p = + if not (has_meta Meta.NoImportGlobal cf.cf_meta) then begin match c.cl_kind with + | KAbstractImpl a -> + if a.a_enum && not (has_class_field_flag cf CfEnum) then + None + else + Some (cf.cf_name,static_abstract_field_resolution a c cf None p) + | _ -> + Some (cf.cf_name,static_field_resolution c cf None p) + end else + None + +let s_resolution_kind = function + | RTypeImport(_,mt) -> Printf.sprintf "RTypeImport(%s)" (s_type_path (t_infos mt).mt_path) + | RClassFieldImport(_,c,cf) -> Printf.sprintf "RClassFieldImport(%s, %s)" (s_type_path c.cl_path) cf.cf_name + | RAbstractFieldImport(_,a,c,cf) -> Printf.sprintf "RAbstractFieldImport(%s, %s)" (s_type_path a.a_path) cf.cf_name + | REnumConstructorImport(_,en,ef) -> Printf.sprintf "REnumConstructorImport(%s, %s)" (s_type_path en.e_path) ef.ef_name + | RWildcardPackage sl -> Printf.sprintf "RWildcardPackage(%s)" (String.concat "." sl) + | RClassStatics c -> Printf.sprintf "RClassStatics(%s)" (s_type_path c.cl_path) + | REnumStatics en -> Printf.sprintf "REnumStatics(%s)" (s_type_path en.e_path) + | RLazy _ -> "RLazy" + +class resolution_list (id : string list) = object(self) + val mutable l = [] + val mutable resolved_lazies = true + val mutable cached_type_imports = true + val mutable type_import_cache = StringMap.empty + + method add (res : resolution) = + l <- res :: l; + (* If we import a type, we automatically want to import all its constructors in case of + enums and enum abstracts. We add a RLazy in front of the list so that it takes priority + over the type itself. When resolved, it will insert its fields into the resolution list. *) + begin match res.r_kind with + | RTypeImport(_,mt) -> + Option.may (fun res -> l <- res :: l) (self#expand_enum_constructors mt); + cached_type_imports <- false; + | RLazy _ -> + resolved_lazies <- false; + | _ -> + () + end + + method resolve_lazies = + let rec loop acc l = match l with + | {r_kind = RLazy f} :: l -> + begin match f() with + | None -> + loop acc l + | Some res -> + loop acc (res :: l) + end + | res :: l -> + loop (res :: acc) l + | [] -> + List.rev acc + in + if not resolved_lazies then begin + resolved_lazies <- true; + l <- loop [] l; + end + + method resolve (i : string) : resolution = + self#resolve_lazies; + let rec loop l = match l with + | [] -> + raise Not_found + | res :: l -> + begin match res.r_kind with + | RClassStatics c -> + ignore(c.cl_build()); + begin try + let cf = PMap.find i c.cl_statics in + begin match as_importable_static c cf res.r_pos with + | None -> + loop l + | Some(_,res) -> + res + end; + with Not_found -> + loop l + end + | REnumStatics en -> + begin try + let ef = PMap.find i en.e_constrs in + if not (has_meta Meta.NoImportGlobal ef.ef_meta) then + enum_constructor_resolution en ef None res.r_pos + else + loop l + with Not_found -> + loop l + end + | RTypeImport(alias,_) | RClassFieldImport(alias,_,_) | RAbstractFieldImport(alias,_,_,_) | REnumConstructorImport(alias,_,_) -> + if alias = i then + res + else + loop l + | RLazy _ | RWildcardPackage _ -> + loop l + end + in + loop l + + method expand_enum_constructors (mt : module_type) = match mt with + | TAbstractDecl ({a_impl = Some c} as a) when a.a_enum -> + Some (class_statics_resolution c null_pos) + | TEnumDecl en -> + Some (enum_statics_resolution en null_pos) + | TTypeDecl t -> + let f () = + begin match follow t.t_type with + | TEnum (e,_) -> self#expand_enum_constructors (TEnumDecl e) + | TAbstract (a,_) when a.a_enum -> self#expand_enum_constructors (TAbstractDecl a) + | _ -> None + end + in + resolved_lazies <- false; + Some (lazy_resolution f) + | TClassDecl _ | TAbstractDecl _ -> + None + + method save = + let l' = l in + let resolved_lazies' = resolved_lazies in + (fun () -> + l <- l'; + resolved_lazies <- resolved_lazies'; + ) + + method get_list = + l + + method cache_type_imports = + let rec loop = function + | [] -> + () + | res :: l -> + (* loop first to retain correct order *) + loop l; + match res.r_kind with + | RTypeImport(alias,mt) -> + type_import_cache <- StringMap.add alias (mt,res.r_pos) type_import_cache; + | _ -> + () + in + if not cached_type_imports then begin + cached_type_imports <- true; + type_import_cache <- StringMap.empty; + loop l + end; + + method find_type_import alias = + self#cache_type_imports; + StringMap.find alias type_import_cache + + method find_type_import_weirdly pack name = + let rec find l = match l with + | [] -> + raise Not_found + | {r_kind = RTypeImport(alias,mt); r_pos = p} :: l -> + if t_path mt = (pack,name) then (mt,p) else find l + | _ :: l -> + find l + in + find l + + method extract_type_imports = + ExtList.List.filter_map (fun res -> match res.r_kind with + | RTypeImport(_,mt) -> + Some (mt,res.r_pos) + | _ -> + None + ) l + + method extract_field_imports = + self#resolve_lazies; + let l = List.fold_left (fun acc res -> match res.r_kind with + | RClassFieldImport(alias,c,cf) -> + PMap.add alias ((TClassDecl c),cf.cf_name,res.r_pos) acc + | RClassStatics c -> + List.fold_left (fun acc cf -> + begin match as_importable_static c cf null_pos with + | Some (alias,res) -> + PMap.add alias ((TClassDecl c),cf.cf_name,res.r_pos) acc + | _ -> + acc + end + ) acc c.cl_ordered_statics + | _ -> + acc + ) PMap.empty l in + l + + method extract_wildcard_packages = + ExtList.List.filter_map (fun res -> match res.r_kind with + | RWildcardPackage sl -> + Some (sl,res.r_pos) + | _ -> + None + ) l +end \ No newline at end of file diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 36a8d8a90cd..bee226c08b9 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -22,6 +22,7 @@ open Ast open Common open Type open Error +open Resolution type type_patch = { mutable tp_type : complex_type option; @@ -59,10 +60,10 @@ type typer_pass = type typer_module = { curmod : module_def; - mutable module_imports : (module_type * pos) list; + import_resolution : resolution_list; + mutable own_resolution : resolution_list option; + mutable enum_with_type : module_type option; mutable module_using : (tclass * pos) list; - mutable module_globals : (string, (module_type * string * pos)) PMap.t; - mutable wildcard_packages : (string list * pos) list; mutable import_statements : import list; } diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index 67f34223306..5a6fb30c134 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -257,6 +257,8 @@ let t_infos t : tinfos = let t_path t = (t_infos t).mt_path +let t_name t = snd (t_path t) + let rec extends c csup = if c == csup || List.exists (fun (i,_) -> extends i csup) c.cl_implements then true diff --git a/src/core/tPrinting.ml b/src/core/tPrinting.ml index 30245cf9f8b..898469e9a27 100644 --- a/src/core/tPrinting.ml +++ b/src/core/tPrinting.ml @@ -605,7 +605,7 @@ module Printer = struct let s_module_def_extra tabs me = s_record_fields tabs [ "m_file",Path.UniqueKey.lazy_path me.m_file; - "m_sign",me.m_sign; + "m_sign",(Digest.to_hex me.m_sign); "m_time",string_of_float me.m_time; "m_cache_state",s_module_cache_state me.m_cache_state; "m_added",string_of_int me.m_added; diff --git a/src/typing/fields.ml b/src/typing/fields.ml index 4e0fc909229..03ddd72bb5d 100644 --- a/src/typing/fields.ml +++ b/src/typing/fields.ml @@ -533,6 +533,22 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) = ) | _ -> raise Not_found in + let type_field_by_module e t = match e.eexpr with + | TTypeExpr mt -> + let infos = t_infos mt in + if snd infos.mt_path <> snd infos.mt_module.m_path then raise Not_found; + (* TODO: This duplicates some code from typerDotPath.ml *) + begin match infos.mt_module.m_statics with + | Some c when PMap.mem i c.cl_statics -> + let cf = PMap.find i c.cl_statics in + field_access e cf (FHStatic c) + | _ -> + let t = Typeload.find_type_in_module infos.mt_module i in + mk_module_type_access ctx t p + end + | _ -> + raise Not_found + in let t = follow_without_type e.etype in try type_field_by_type e t @@ -542,6 +558,8 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) = type_field_by_module_extension e t with Not_found -> try type_field_by_fallback e t + with Not_found -> try + type_field_by_module e t with Not_found when not (TypeFieldConfig.do_resume cfg) -> if not ctx.untyped then begin let has_special_field a = diff --git a/src/typing/instanceBuilder.ml b/src/typing/instanceBuilder.ml index cbc7e5cec0a..27f958275e2 100644 --- a/src/typing/instanceBuilder.ml +++ b/src/typing/instanceBuilder.ml @@ -17,7 +17,7 @@ let get_macro_path ctx e args p = if not (PMap.mem i ctx.curclass.cl_statics) then raise Not_found; ctx.curclass.cl_path with Not_found -> try - (t_infos (let path,_,_ = PMap.find i ctx.m.module_globals in path)).mt_path + (t_infos (let path,_,_ = PMap.find i (ctx.m.import_resolution#extract_field_imports) in path)).mt_path with Not_found -> raise_typing_error "Invalid macro call" p in diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index 4c6a79f5b90..fc2ebb50b2b 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -22,6 +22,7 @@ open DisplayTypes.DisplayMode open Common open Type open Typecore +open Resolution open Error open Globals @@ -569,23 +570,20 @@ let make_macro_api ctx mctx p = | NormalAndMacroContext -> add ctx; add_macro ctx; ); MacroApi.with_imports = (fun imports usings f -> - let old_globals = ctx.m.module_globals in - let old_imports = ctx.m.module_imports in + let restore_resolution = ctx.m.import_resolution#save in let old_using = ctx.m.module_using in let run () = - let context_init = new TypeloadFields.context_init in List.iter (fun (path,mode) -> - ImportHandling.init_import ctx context_init path mode null_pos + ImportHandling.init_import ctx path mode null_pos ) imports; List.iter (fun path -> - ImportHandling.init_using ctx context_init path null_pos + ImportHandling.init_using ctx path null_pos ) usings; - context_init#run; + flush_pass ctx PConnectField "with_imports"; f() in let restore () = - ctx.m.module_globals <- old_globals; - ctx.m.module_imports <- old_imports; + restore_resolution(); ctx.m.module_using <- old_using; in Std.finally restore run () @@ -751,10 +749,10 @@ let load_macro_module mctx com cpath display p = let mloaded = TypeloadModule.load_module mctx m p in mctx.m <- { curmod = mloaded; - module_imports = []; + import_resolution = new resolution_list ["import";s_type_path cpath]; + own_resolution = None; + enum_with_type = None; module_using = []; - module_globals = PMap.empty; - wildcard_packages = []; import_statements = []; }; mloaded,(fun () -> mctx.com.display <- old) @@ -792,10 +790,10 @@ let load_macro'' com mctx display cpath f p = mctx.com.cached_macros#add (cpath,f) meth; mctx.m <- { curmod = null_module; - module_imports = []; + import_resolution = new resolution_list ["import";s_type_path cpath]; + own_resolution = None; + enum_with_type = None; module_using = []; - module_globals = PMap.empty; - wildcard_packages = []; import_statements = []; }; t(); diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index 9944878c7b3..6d5018e544f 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -116,20 +116,24 @@ with Error { err_message = (Module_not_found _ | Type_not_found _); err_pos = p2 (** since load_type_def and load_instance are used in PASS2, they should not access the structure of a type **) let find_type_in_current_module_context ctx pack name = - let no_pack = pack = [] in - let path_matches t2 = - let tp = t_path t2 in - (* see also https://github.com/HaxeFoundation/haxe/issues/9150 *) - tp = (pack,name) || (no_pack && snd tp = name) - in - try - (* Check the types in our own module *) - List.find path_matches ctx.m.curmod.m_types - with Not_found -> - (* Check the local imports *) - let t,pi = List.find (fun (t2,pi) -> path_matches t2) ctx.m.module_imports in - ImportHandling.mark_import_position ctx pi; + if pack = [] then begin + try + (* Check the types in our own module *) + List.find (fun mt -> t_name mt = name) ctx.m.curmod.m_types + with Not_found -> + let t,pi = ctx.m.import_resolution#find_type_import name in + ImportHandling.mark_import_position ctx pi; + t + end else begin + (* All this is very weird *) + try + List.find (fun mt -> t_path mt = (pack,name)) ctx.m.curmod.m_types + with Not_found -> + (* see also https://github.com/HaxeFoundation/haxe/issues/9150 *) + let t,pi = ctx.m.import_resolution#find_type_import_weirdly pack name in + ImportHandling.mark_import_position ctx pi; t + end let find_in_wildcard_imports ctx mname p f = let rec loop l = @@ -153,7 +157,7 @@ let find_in_wildcard_imports ctx mname p f = loop l end in - loop ctx.m.wildcard_packages + loop (ctx.m.import_resolution#extract_wildcard_packages) (* TODO: move these generic find functions into a separate module *) let find_in_modules_starting_from_current_package ~resume ctx mname p f = @@ -212,6 +216,12 @@ let load_qualified_type_def ctx pack mname tname p = let m = load_module ctx (pack,mname) p in find_type_in_module_raise ctx m tname p +let load_type_def' ctx pack mname tname p = + if pack = [] then + load_unqualified_type_def ctx mname tname p + else + load_qualified_type_def ctx pack mname tname p + (* load a type or a subtype definition *) @@ -219,17 +229,14 @@ let load_type_def ctx p t = if t = Parser.magic_type_path then raise_fields (DisplayToplevel.collect ctx TKType NoValue true) CRTypeHint (DisplayTypes.make_subject None p); (* The type name is the module name or the module sub-type name *) - let tname = (match t.tsub with None -> t.tname | Some n -> n) in + let tname = match t.tsub with None -> t.tname | Some n -> n in try (* If there's a sub-type, there's no reason to look in our module or its imports *) if t.tsub <> None then raise Not_found; find_type_in_current_module_context ctx t.tpackage tname with Not_found -> - if t.tpackage = [] then - load_unqualified_type_def ctx t.tname tname p - else - load_qualified_type_def ctx t.tpackage t.tname tname p + load_type_def' ctx t.tpackage t.tname tname p (* let load_type_def ctx p t = let timer = Timer.timer ["typing";"load_type_def"] in @@ -701,10 +708,10 @@ let hide_params ctx = let old_deps = ctx.g.std.m_extra.m_deps in ctx.m <- { curmod = ctx.g.std; - module_imports = []; + import_resolution = new Resolution.resolution_list ["hide_params"]; + own_resolution = None; + enum_with_type = None; module_using = []; - module_globals = PMap.empty; - wildcard_packages = []; import_statements = []; }; ctx.type_params <- []; diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml index fd2ff03c618..a177dec046b 100644 --- a/src/typing/typeloadCheck.ml +++ b/src/typing/typeloadCheck.ml @@ -527,30 +527,9 @@ module Inheritance = struct raise (Build_canceled state) in let has_interf = ref false in - (* - resolve imports before calling build_inheritance, since it requires full paths. - that means that typedefs are not working, but that's a fair limitation - *) - let resolve_imports (t,p) = - match t.tpackage with - | _ :: _ -> t,p - | [] -> - try - let path_matches lt = snd (t_path lt) = t.tname in - let lt = try - List.find path_matches ctx.m.curmod.m_types - with Not_found -> - let t,pi = List.find (fun (lt,_) -> path_matches lt) ctx.m.module_imports in - ImportHandling.mark_import_position ctx pi; - t - in - { t with tpackage = fst (t_path lt) },p - with - Not_found -> t,p - in let herits = ExtList.List.filter_map (function - | HExtends t -> Some(true,resolve_imports t) - | HImplements t -> Some(false,resolve_imports t) + | HExtends t -> Some(true,t) + | HImplements t -> Some(false,t) | t -> None ) herits in let herits = List.filter (ctx.g.do_inherit ctx c p) herits in diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index 49a418913a1..e964d3ae775 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -30,18 +30,6 @@ open CompletionItem.ClassFieldOrigin open Common open Error -class context_init = object(self) - val mutable l = [] - - method add (f : unit -> unit) = - l <- f :: l - - method run = - let l' = l in - l <- []; - List.iter (fun f -> f()) (List.rev l') -end - type class_init_ctx = { tclass : tclass; (* I don't trust ctx.curclass because it's mutable. *) is_lib : bool; @@ -50,7 +38,6 @@ type class_init_ctx = { is_class_debug : bool; extends_public : bool; abstract : tabstract option; - context_init : context_init; mutable has_display_field : bool; mutable delayed_expr : (typer * tlazy ref option) list; mutable force_constructor : bool; @@ -479,7 +466,7 @@ let apply_macro ctx mode path el p = ) in ctx.g.do_macro ctx mode cpath meth el p -let build_module_def ctx mt meta fvars context_init fbuild = +let build_module_def ctx mt meta fvars fbuild = let is_typedef = match mt with TTypeDecl _ -> true | _ -> false in let loop f_build = function | Meta.Build,args,p when not is_typedef -> (fun () -> @@ -491,7 +478,6 @@ let build_module_def ctx mt meta fvars context_init fbuild = if ctx.com.is_macro_context then raise_typing_error "You cannot use @:build inside a macro : make sure that your type is not used in macro" p; let old = ctx.get_build_infos in ctx.get_build_infos <- (fun() -> Some (mt, extract_param_types (t_infos mt).mt_params, fvars())); - context_init#run; let r = try apply_macro ctx MBuild s el p with e -> ctx.get_build_infos <- old; raise e in ctx.get_build_infos <- old; (match r with @@ -524,7 +510,6 @@ let build_module_def ctx mt meta fvars context_init fbuild = let f_enum = match mt with | TClassDecl ({cl_kind = KAbstractImpl a} as c) when a.a_enum -> Some (fun () -> - context_init#run; let e = build_enum_abstract ctx c a (fvars()) a.a_name_pos in fbuild e; ) @@ -545,7 +530,7 @@ let build_module_def ctx mt meta fvars context_init fbuild = List.iter (fun f -> f()) (List.rev f_build); (match f_enum with None -> () | Some f -> f()) -let create_class_context c context_init p = +let create_class_context c p = let abstract = match c.cl_kind with | KAbstractImpl a -> Some a | _ -> None @@ -567,7 +552,6 @@ let create_class_context c context_init p = is_class_debug = Meta.has (Meta.Custom ":debug.typeload") c.cl_meta; extends_public = extends_public c; abstract = abstract; - context_init = context_init; force_constructor = false; uninitialized_final = []; delayed_expr = []; @@ -738,7 +722,7 @@ let build_fields (ctx,cctx) c fields = let get_fields() = !fields in let pending = ref [] in c.cl_build <- (fun() -> BuildMacro pending); - build_module_def ctx (TClassDecl c) c.cl_meta get_fields cctx.context_init (fun (e,p) -> + build_module_def ctx (TClassDecl c) c.cl_meta get_fields (fun (e,p) -> match e with | EVars [{ ev_type = Some (CTAnonymous f,p); ev_expr = None }] -> let f = List.map (fun f -> transform_field (ctx,cctx) c f fields p) f in @@ -877,7 +861,6 @@ module TypeBinding = struct (* type constant init fields (issue #1956) *) if not !return_partial_type || (match fst e with EConst _ -> true | _ -> false) then begin r := lazy_processing (fun() -> t); - cctx.context_init#run; if ctx.com.verbose then Common.log ctx.com ("Typing " ^ (if ctx.com.is_macro_context then "macro " else "") ^ s_type_path c.cl_path ^ "." ^ cf.cf_name); let e = type_var_field ctx t e fctx.is_static fctx.is_display_field p in let maybe_run_analyzer e = match e.eexpr with @@ -954,7 +937,6 @@ module TypeBinding = struct let c = cctx.tclass in let bind r = r := lazy_processing (fun() -> t); - cctx.context_init#run; incr stats.s_methods_typed; if ctx.com.verbose then Common.log ctx.com ("Typing " ^ (if ctx.com.is_macro_context then "macro " else "") ^ s_type_path c.cl_path ^ "." ^ cf.cf_name); let fmode = (match cctx.abstract with @@ -1752,8 +1734,8 @@ let check_functional_interface ctx c = add_class_flag c CFunctionalInterface; ctx.g.functional_interface_lut#add c.cl_path cf -let init_class ctx c p context_init herits fields = - let cctx = create_class_context c context_init p in +let init_class ctx c p herits fields = + let cctx = create_class_context c p in let ctx = create_typer_context_for_class ctx cctx p in if cctx.is_class_debug then print_endline ("Created class context: " ^ dump_class_context cctx); let fields = patch_class ctx c fields in diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index d9e2e62c8f3..d96e0f18515 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -27,6 +27,7 @@ open DisplayTypes.DisplayMode open Common open Typeload open Error +open Resolution let get_policy g mpath = let sl1 = full_dot_path2 mpath mpath in @@ -401,7 +402,7 @@ module TypeLevel = struct DisplayEmitter.display_enum_field ctx e f p; f,cf - let init_class ctx context_init c d p = + let init_class ctx c d p = if ctx.is_display_file && DisplayPosition.display_position#enclosed_in (pos d.d_name) then DisplayEmitter.display_module_type ctx (match c.cl_kind with KAbstractImpl a -> TAbstractDecl a | _ -> TClassDecl c) (pos d.d_name); TypeloadCheck.check_global_metadata ctx c.cl_meta (fun m -> c.cl_meta <- m :: c.cl_meta) c.cl_module.m_path c.cl_path None; @@ -419,7 +420,7 @@ module TypeLevel = struct c.cl_build <- (fun()-> Building [c]); try List.iter (fun f -> f()) fl; - TypeloadFields.init_class ctx c p context_init d.d_flags d.d_data; + TypeloadFields.init_class ctx c p d.d_flags d.d_data; c.cl_build <- (fun()-> Built); incr build_count; List.iter (fun tp -> ignore(follow tp.ttp_type)) c.cl_params; @@ -469,7 +470,7 @@ module TypeLevel = struct | _ -> () ) - let init_enum ctx context_init e d p = + let init_enum ctx e d p = if ctx.is_display_file && DisplayPosition.display_position#enclosed_in (pos d.d_name) then DisplayEmitter.display_module_type ctx (TEnumDecl e) (pos d.d_name); let ctx = { ctx with type_params = e.e_params } in @@ -495,7 +496,7 @@ module TypeLevel = struct } ) (!constructs) in - TypeloadFields.build_module_def ctx (TEnumDecl e) e.e_meta get_constructs context_init (fun (e,p) -> + TypeloadFields.build_module_def ctx (TEnumDecl e) e.e_meta get_constructs (fun (e,p) -> match e with | EVars [{ ev_type = Some (CTAnonymous fields,p); ev_expr = None }] -> constructs := List.map (fun f -> @@ -551,7 +552,7 @@ module TypeLevel = struct ) e.e_constrs ) - let init_typedef ctx context_init t d p = + let init_typedef ctx t d p = if ctx.is_display_file && DisplayPosition.display_position#enclosed_in (pos d.d_name) then DisplayEmitter.display_module_type ctx (TTypeDecl t) (pos d.d_name); TypeloadCheck.check_global_metadata ctx t.t_meta (fun m -> t.t_meta <- m :: t.t_meta) t.t_module.m_path t.t_path None; @@ -596,14 +597,14 @@ module TypeLevel = struct | None -> Monomorph.bind r tt; | Some _ -> die "" __LOC__); | _ -> die "" __LOC__); - TypeloadFields.build_module_def ctx (TTypeDecl t) t.t_meta (fun _ -> []) context_init (fun _ -> ()); + TypeloadFields.build_module_def ctx (TTypeDecl t) t.t_meta (fun _ -> []) (fun _ -> ()); if ctx.com.platform = Cs && t.t_meta <> [] then delay ctx PTypeField (fun () -> let metas = StrictMeta.check_strict_meta ctx t.t_meta in if metas <> [] then t.t_meta <- metas @ t.t_meta; ) - let init_abstract ctx context_init a d p = + let init_abstract ctx a d p = if ctx.is_display_file && DisplayPosition.display_position#enclosed_in (pos d.d_name) then DisplayEmitter.display_module_type ctx (TAbstractDecl a) (pos d.d_name); TypeloadCheck.check_global_metadata ctx a.a_meta (fun m -> a.a_meta <- m :: a.a_meta) a.a_module.m_path a.a_path None; @@ -667,10 +668,10 @@ module TypeLevel = struct (* In this pass, we can access load and access other modules types, but we cannot follow them or access their structure - since they have not been setup. We also build a context_init list that will be evaluated the first time we evaluate + since they have not been setup. We also build a list that will be evaluated the first time we evaluate an expression into the context *) - let init_module_type ctx context_init (decl,p) = + let init_module_type ctx (decl,p) = let get_type name = try List.find (fun t -> snd (t_infos t).mt_path = name) ctx.m.curmod.m_types with Not_found -> die "" __LOC__ in @@ -681,39 +682,44 @@ module TypeLevel = struct | EImport (path,mode) -> begin try check_path_display path p; - ImportHandling.init_import ctx context_init path mode p; + ImportHandling.init_import ctx path mode p; ImportHandling.commit_import ctx path mode p; with Error err -> display_error_ext ctx.com err end | EUsing path -> check_path_display path p; - ImportHandling.init_using ctx context_init path p + ImportHandling.init_using ctx path p | EClass d -> let c = (match get_type (fst d.d_name) with TClassDecl c -> c | _ -> die "" __LOC__) in - init_class ctx context_init c d p + init_class ctx c d p | EEnum d -> let e = (match get_type (fst d.d_name) with TEnumDecl e -> e | _ -> die "" __LOC__) in - init_enum ctx context_init e d p + init_enum ctx e d p | ETypedef d -> let t = (match get_type (fst d.d_name) with TTypeDecl t -> t | _ -> die "" __LOC__) in - init_typedef ctx context_init t d p + init_typedef ctx t d p | EAbstract d -> let a = (match get_type (fst d.d_name) with TAbstractDecl a -> a | _ -> die "" __LOC__) in - init_abstract ctx context_init a d p + init_abstract ctx a d p | EStatic _ -> (* nothing to do here as module fields are collected into a special EClass *) () end -let make_curmod ctx m = { - curmod = m; - module_imports = List.map (fun t -> t,null_pos) ctx.g.std.m_types; - module_using = []; - module_globals = PMap.empty; - wildcard_packages = []; - import_statements = []; -} +let make_curmod ctx m = + let rl = new resolution_list ["import";s_type_path m.m_path] in + List.iter (fun mt -> + rl#add (module_type_resolution mt None null_pos)) + (List.rev ctx.g.std.m_types); + { + curmod = m; + import_resolution = rl; + own_resolution = None; + enum_with_type = None; + module_using = []; + import_statements = []; + } let create_typer_context_for_module ctx m = { com = ctx.com; @@ -769,10 +775,9 @@ let type_types_into_module ctx m tdecls p = end; ModuleLevel.init_type_params ctx decls; (* setup module types *) - let context_init = new TypeloadFields.context_init in - List.iter (TypeLevel.init_module_type ctx context_init) tdecls; + List.iter (TypeLevel.init_module_type ctx) tdecls; (* Make sure that we actually init the context at some point (issue #9012) *) - delay ctx PConnectField (fun () -> context_init#run); + delay ctx PConnectField (fun () -> ctx.m.import_resolution#resolve_lazies); ctx (* diff --git a/src/typing/typer.ml b/src/typing/typer.ml index 6250fd4e216..aced3ca13b0 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -24,6 +24,7 @@ open CompletionItem.ClassFieldOrigin open Common open Type open Typecore +open Resolution open Error open Globals open TyperBase @@ -67,6 +68,20 @@ let get_iterable_param t = raise Not_found) | _ -> raise Not_found +let get_own_resolution ctx = match ctx.m.own_resolution with + | Some resolution -> + resolution + | None -> + let rl = new resolution_list ["own";s_type_path ctx.m.curmod.m_path] in + Option.may (fun c -> + rl#add (class_statics_resolution c null_pos) + ) ctx.m.curmod.m_statics; + List.iter (fun mt -> + rl#add (module_type_resolution mt None null_pos) + ) ctx.m.curmod.m_types; + ctx.m.own_resolution <- Some rl; + rl + let maybe_type_against_enum ctx f with_type iscall p = try begin match with_type with @@ -90,9 +105,9 @@ let maybe_type_against_enum ctx f with_type iscall p = raise Exit in let is_enum,path,fields,mt = loop [] t in - let old = ctx.m.curmod.m_types in - let restore () = ctx.m.curmod.m_types <- old in - ctx.m.curmod.m_types <- ctx.m.curmod.m_types @ [mt]; + let old = ctx.m.enum_with_type in + let restore () = ctx.m.enum_with_type <- old in + ctx.m.enum_with_type <- Some mt; let e = try f() with @@ -258,8 +273,66 @@ let unify_min_for_type_source ctx el src = | _ -> unify_min ctx el +let enum_field_access ctx en ef mode p pt = + let et = type_module_type ctx (TEnumDecl en) p in + let wrap e = + let acc = AKExpr e in + let is_set = match mode with MSet _ -> true | _ -> false in + (* Should this really be here? *) + if is_set then + AKNo(acc,p) + else + acc + in + wrap (mk (TField (et,FEnum (en,ef))) (enum_field_type ctx en ef p) p) + +let resolve_against_expected_enum ctx i = + let rec loop mt = match mt with + | TAbstractDecl ({a_impl = Some c} as a) when a.a_enum -> + let cf = PMap.find i c.cl_statics in + if not (has_class_field_flag cf CfEnum) then + raise Not_found; + static_abstract_field_resolution a c cf None null_pos + | TClassDecl _ | TAbstractDecl _ -> + raise Not_found + | TTypeDecl t -> + begin match follow t.t_type with + | TEnum (e,_) -> loop (TEnumDecl e) + | TAbstract (a,_) when a.a_enum -> loop (TAbstractDecl a) + | _ -> raise Not_found + end + | TEnumDecl en -> + let ef = PMap.find i en.e_constrs in + enum_constructor_resolution en ef None null_pos + in + match ctx.m.enum_with_type with + | None -> + raise Not_found + | Some mt -> + loop mt + let rec type_ident_raise ctx i p mode with_type = - let is_set = match mode with MSet _ -> true | _ -> false in + let resolve res = + ImportHandling.mark_import_position ctx res.r_pos; + match res.r_kind with + | RTypeImport(_,mt) -> + AKExpr (type_module_type ctx mt p) + | RClassFieldImport(_,c,cf) -> + let e = type_module_type ctx (TClassDecl c) p in + field_access ctx mode cf (FHStatic c) e p + | RAbstractFieldImport(_,a,c,cf) -> + let et = type_module_type ctx (TClassDecl c) p in + let inline = match cf.cf_kind with + | Var {v_read = AccInline} -> true + | _ -> false + in + let fa = FieldAccess.create et cf (FHAbstract(a,extract_param_types a.a_params,c)) inline p in + AKField fa + | REnumConstructorImport(_,en,ef) -> + enum_field_access ctx en ef mode p res.r_pos + | RWildcardPackage _ | RLazy _ | RClassStatics _ | REnumStatics _ -> + assert false + in match i with | "true" -> let acc = AKExpr (mk (TConst (TBool true)) ctx.t.tbool p) in @@ -390,74 +463,17 @@ let rec type_ident_raise ctx i p mode with_type = let e = {e with etype = TAbstract(a,tl)} in e,FHAbstract(a,tl,ctx.curclass) | _ -> - let e = type_type ctx ctx.curclass.cl_path p in + let e = type_module_type ctx (TClassDecl ctx.curclass) p in e,FHStatic ctx.curclass in field_access ctx mode f fa e p with Not_found -> try - (* module-level statics *) - (match ctx.m.curmod.m_statics with - | None -> raise Not_found - | Some c -> - let f = PMap.find i c.cl_statics in - let e = type_module_type ctx (TClassDecl c) p in - field_access ctx mode f (FHStatic c) e p - ) + resolve (resolve_against_expected_enum ctx i) with Not_found -> try - let wrap e = - let acc = AKExpr e in - if is_set then - AKNo(acc,p) - else - acc - in - (* lookup imported enums *) - let rec loop l = - match l with - | [] -> raise Not_found - | (t,pt) :: l -> - match t with - | TAbstractDecl ({a_impl = Some c} as a) when a.a_enum -> - begin try - let cf = PMap.find i c.cl_statics in - if not (has_class_field_flag cf CfEnum) then - loop l - else begin - let et = type_module_type ctx (TClassDecl c) p in - let inline = match cf.cf_kind with - | Var {v_read = AccInline} -> true - | _ -> false - in - let fa = FieldAccess.create et cf (FHAbstract(a,extract_param_types a.a_params,c)) inline p in - ImportHandling.mark_import_position ctx pt; - AKField fa - end - with Not_found -> - loop l - end - | TClassDecl _ | TAbstractDecl _ -> - loop l - | TTypeDecl t -> - (match follow t.t_type with - | TEnum (e,_) -> loop ((TEnumDecl e,pt) :: l) - | TAbstract (a,_) when a.a_enum -> loop ((TAbstractDecl a,pt) :: l) - | _ -> loop l) - | TEnumDecl e -> - try - let ef = PMap.find i e.e_constrs in - let et = type_module_type ctx t p in - ImportHandling.mark_import_position ctx pt; - wrap (mk (TField (et,FEnum (e,ef))) (enum_field_type ctx e ef p) p) - with - Not_found -> loop l - in - (try loop (List.rev_map (fun t -> t,null_pos) ctx.m.curmod.m_types) with Not_found -> loop ctx.m.module_imports) + let own_resolution = get_own_resolution ctx in + resolve (own_resolution#resolve i) with Not_found -> - (* lookup imported globals *) - let t, name, pi = PMap.find i ctx.m.module_globals in - ImportHandling.mark_import_position ctx pi; - let e = type_module_type ctx t p in - type_field_default_cfg ctx e name p mode with_type + resolve (ctx.m.import_resolution#resolve i) and type_ident ctx i p mode with_type = try @@ -465,7 +481,11 @@ and type_ident ctx i p mode with_type = with Not_found -> try (* lookup type *) if is_lower_ident i p then raise Not_found; - let e = (try type_type ctx ([],i) p with Error { err_message = Module_not_found ([],name) } when name = i -> raise Not_found) in + let e = try + type_module_type ctx (Typeload.load_type_def' ctx [] i i p) p + with Error { err_message = Module_not_found ([],name) } when name = i -> + raise Not_found + in AKExpr e with Not_found -> let resolved_to_type_parameter = ref false in @@ -1623,6 +1643,16 @@ and type_meta ?(mode=MGet) ctx m e1 with_type p = | (Meta.Dollar s,_,p) -> display_error ctx.com (Printf.sprintf "Reification $%s is not allowed outside of `macro` expression" s) p; e() + | (Meta.Custom ":debug.import",_,_) -> + let print l = + let sl = List.map (fun res -> s_resolution_kind res.r_kind) l in + print_endline (String.concat "\n" sl); + in + print_endline "OWN:"; + print (get_own_resolution ctx)#get_list; + print_endline "IMPORT:"; + print ctx.m.import_resolution#get_list; + e() | _ -> if ctx.g.retain_meta then let e = e() in @@ -2026,10 +2056,10 @@ let create com macros = }; m = { curmod = null_module; - module_imports = []; + import_resolution = new resolution_list ["import";"typer"]; + own_resolution = None; + enum_with_type = None; module_using = []; - module_globals = PMap.empty; - wildcard_packages = []; import_statements = []; }; is_display_file = false; @@ -2074,7 +2104,9 @@ let create com macros = raise_typing_error "Standard library not found. You may need to set your `HAXE_STD_PATH` environment variable" null_pos ); (* We always want core types to be available so we add them as default imports (issue #1904 and #3131). *) - ctx.m.module_imports <- List.map (fun t -> t,null_pos) ctx.g.std.m_types; + List.iter (fun mt -> + ctx.m.import_resolution#add (module_type_resolution mt None null_pos)) + (List.rev ctx.g.std.m_types); List.iter (fun t -> match t with | TAbstractDecl a -> diff --git a/tests/display/src/cases/Issue7020.hx b/tests/display/src/cases/Issue7020.hx index 4a5b7db3bb2..7659b0d8b36 100644 --- a/tests/display/src/cases/Issue7020.hx +++ b/tests/display/src/cases/Issue7020.hx @@ -11,8 +11,8 @@ class Issue7020 extends DisplayTestCase { } **/ function test() { - eq(range(2, 3), position(pos(1))); + // eq(range(2, 3), position(pos(1))); eq(range(2, 3), position(pos(4))); - eq("_String.ExprAccess", type(pos(4))); + eq("String", type(pos(4))); } } diff --git a/tests/misc/projects/Issue2729/Macro.hx b/tests/misc/projects/Issue2729/Macro.hx new file mode 100644 index 00000000000..607df0bda32 --- /dev/null +++ b/tests/misc/projects/Issue2729/Macro.hx @@ -0,0 +1,9 @@ +import haxe.macro.Context; +import haxe.macro.Expr; + +class Macro { + static function build():Array { + var fields = Context.getBuildFields(); + return fields; + } +} diff --git a/tests/misc/projects/Issue2729/Main1.hx b/tests/misc/projects/Issue2729/Main1.hx new file mode 100644 index 00000000000..f8458a7928a --- /dev/null +++ b/tests/misc/projects/Issue2729/Main1.hx @@ -0,0 +1,13 @@ +import Main1.OtherClass.*; + +@:publicFields +@:build(Macro.build()) +class OtherClass { + static var foo = 123; +} + +class Main1 { + static function main() { + trace(foo); // Unknown identifier : foo + } +} diff --git a/tests/misc/projects/Issue2729/Main2.hx b/tests/misc/projects/Issue2729/Main2.hx new file mode 100644 index 00000000000..1a54edf0d26 --- /dev/null +++ b/tests/misc/projects/Issue2729/Main2.hx @@ -0,0 +1,13 @@ +import Main2.OtherClass.foo; // fails directly on import + +@:publicFields +@:build(Macro.build()) +class OtherClass { + static var foo = 123; +} + +class Main2 { + static function main() { + trace(foo); // Unknown identifier : foo + } +} diff --git a/tests/misc/projects/Issue2729/build1.hxml b/tests/misc/projects/Issue2729/build1.hxml new file mode 100644 index 00000000000..66d6f07911e --- /dev/null +++ b/tests/misc/projects/Issue2729/build1.hxml @@ -0,0 +1 @@ +Main1 \ No newline at end of file diff --git a/tests/misc/projects/Issue2729/build2.hxml b/tests/misc/projects/Issue2729/build2.hxml new file mode 100644 index 00000000000..1a42b990ec1 --- /dev/null +++ b/tests/misc/projects/Issue2729/build2.hxml @@ -0,0 +1 @@ +Main2 diff --git a/tests/misc/projects/Issue6794/Main.hx b/tests/misc/projects/Issue6794/Main.hx index 59325374219..f23eb62057d 100644 --- a/tests/misc/projects/Issue6794/Main.hx +++ b/tests/misc/projects/Issue6794/Main.hx @@ -1,5 +1,4 @@ #if macro -import haxe.macro.Expr; import haxe.macro.Context; #end diff --git a/tests/misc/projects/Issue6794/compile.hxml.stderr b/tests/misc/projects/Issue6794/compile.hxml.stderr index 6a0dcd1b828..48da02e6fd4 100644 --- a/tests/misc/projects/Issue6794/compile.hxml.stderr +++ b/tests/misc/projects/Issue6794/compile.hxml.stderr @@ -1 +1 @@ -[{"file":"$$normPath(::cwd::/,true)Main.hx","diagnostics":[{"kind":2,"severity":2,"range":{"start":{"line":13,"character":42},"end":{"line":13,"character":43}},"args":"foo","code":"WUser","relatedInformation":[]}]}] +[{"file":"$$normPath(::cwd::/,true)Main.hx","diagnostics":[{"kind":2,"severity":2,"range":{"start":{"line":12,"character":42},"end":{"line":12,"character":43}},"args":"foo","code":"WUser","relatedInformation":[]}]}] diff --git a/tests/misc/projects/Issue9197/MainBad.hx b/tests/misc/projects/Issue9197/MainBad.hx new file mode 100644 index 00000000000..640083b9b95 --- /dev/null +++ b/tests/misc/projects/Issue9197/MainBad.hx @@ -0,0 +1,13 @@ +class Bar { + public static var someVar : String = "Yay"; +} + +enum Foo { + Bar; +} + +class MainBad { + static function main() { + Bar.someVar = "test"; + } +} \ No newline at end of file diff --git a/tests/misc/projects/Issue9197/MainGood.hx b/tests/misc/projects/Issue9197/MainGood.hx new file mode 100644 index 00000000000..098eb090781 --- /dev/null +++ b/tests/misc/projects/Issue9197/MainGood.hx @@ -0,0 +1,13 @@ +enum Foo { + Bar; +} + +class Bar { + public static var someVar : String = "Yay"; +} + +class MainGood { + static function main() { + Bar.someVar = "test"; + } +} \ No newline at end of file diff --git a/tests/misc/projects/Issue9197/compile-fail.hxml b/tests/misc/projects/Issue9197/compile-fail.hxml new file mode 100644 index 00000000000..1713734bd67 --- /dev/null +++ b/tests/misc/projects/Issue9197/compile-fail.hxml @@ -0,0 +1,2 @@ +--main MainBad +--interp diff --git a/tests/misc/projects/Issue9197/compile-fail.hxml.stderr b/tests/misc/projects/Issue9197/compile-fail.hxml.stderr new file mode 100644 index 00000000000..fe4128f520b --- /dev/null +++ b/tests/misc/projects/Issue9197/compile-fail.hxml.stderr @@ -0,0 +1 @@ +MainBad.hx:11: characters 7-14 : Foo has no field someVar \ No newline at end of file diff --git a/tests/misc/projects/Issue9197/compile.hxml b/tests/misc/projects/Issue9197/compile.hxml new file mode 100644 index 00000000000..fb43076e265 --- /dev/null +++ b/tests/misc/projects/Issue9197/compile.hxml @@ -0,0 +1,2 @@ +--main MainGood +--interp diff --git a/tests/misc/resolution/projects/spec/Issue9150.hx b/tests/misc/resolution/projects/spec/Issue9150.hx deleted file mode 100644 index 1c12cb59c75..00000000000 --- a/tests/misc/resolution/projects/spec/Issue9150.hx +++ /dev/null @@ -1,7 +0,0 @@ -import pack.Mod; - -class Issue9150 extends utest.Test { - function test() { - Macro.assert("pack.ModSubType"); - } -} diff --git a/tests/misc/resolution/projects/spec/Main.hx b/tests/misc/resolution/projects/spec/Main.hx index 7dd5bfd8649..6eb04d561fd 100644 --- a/tests/misc/resolution/projects/spec/Main.hx +++ b/tests/misc/resolution/projects/spec/Main.hx @@ -7,7 +7,7 @@ class Main extends utest.Test { Macro.assert("pack.ModNoValue.ModNoValueSubType"); Macro.assert("pack.ModWithStatic.TheStatic"); } - + function testQualifiedStd() { Macro.assert("std.pack.Mod"); Macro.assert("std.pack.Mod.Mod"); @@ -16,7 +16,7 @@ class Main extends utest.Test { Macro.assert("std.pack.ModNoValue.ModNoValueSubType"); Macro.assert("std.pack.ModWithStatic.TheStatic"); } - + function testQualifiedStdShadowed() { var pack = 1; Macro.assert("std.pack.Mod"); @@ -31,7 +31,6 @@ class Main extends utest.Test { utest.UTest.run([ new Main(), new pack.inner.Test(), - new Issue9150(), new Wildcard(), new Imported(), ]); diff --git a/tests/unit/src/unit/TestPython.hx b/tests/unit/src/unit/TestPython.hx index b6f7d0af7b2..0e8a970a25b 100644 --- a/tests/unit/src/unit/TestPython.hx +++ b/tests/unit/src/unit/TestPython.hx @@ -1,21 +1,17 @@ package unit; import python.KwArgs; -import python.Syntax; -import python.VarArgs; -import sys.io.File; -import sys.io.Process; - -// check compilation python classes import python.NativeArrayTools; import python.NativeStringTools; - +import python.Set; +import python.Syntax; +import python.Tuple; +import python.VarArgs; import python.lib.Codecs; import python.lib.Functools; import python.lib.Glob; import python.lib.Inspect; import python.lib.Json; - import python.lib.Math; import python.lib.Msvcrt; import python.lib.Os; @@ -31,14 +27,10 @@ import python.lib.ThreadLowLevel; import python.lib.Time; import python.lib.Traceback; import python.lib.Tty; -import python.Tuple; -import python.Set; - import python.lib.datetime.Datetime; import python.lib.datetime.Timedelta; import python.lib.datetime.Timezone; import python.lib.datetime.Tzinfo; - import python.lib.io.BufferedIOBase; import python.lib.io.BufferedRWPair; import python.lib.io.BufferedRandom; @@ -50,45 +42,39 @@ import python.lib.io.IOBase; import python.lib.io.RawIOBase; import python.lib.io.StringIO; import python.lib.io.TextIOBase; - +import python.lib.json.JSONEncoder; import python.lib.socket.Address; import python.lib.socket.Socket; - import python.lib.subprocess.Popen; - import python.lib.threading.Thread; - import python.lib.xml.etree.ElementTree; +import sys.io.File; +import sys.io.Process; -import python.lib.json.JSONEncoder; - - - +// check compilation python classes private typedef T = { var value:Int; var ?maybeValue:Int; } -private enum MyEnum { - A(?x:Int, b:String); - True; - False; -} - private interface IA {} - -private class A implements IA { } +private class A implements IA {} private class B extends A { public function new() {} } -class TestPython extends Test { +private enum MyEnum { + A(?x:Int, b:String); + True; + False; +} - public function testDoWhileAsExpression () { +class TestPython extends Test { + public function testDoWhileAsExpression() { var x = 1; - var z = function () return (do { + var z = function() return (do { x++; } while (x < 3)); @@ -97,7 +83,7 @@ class TestPython extends Test { eq(3, x); } - public function testKeywords () { + public function testKeywords() { var list = new Array(); noAssert(); } @@ -116,7 +102,6 @@ class TestPython extends Test { eq("foo", o.toLowerCase()); } - public function testOptionalStructureFields() { var v:T = haxe.Json.parse('{"value": 1 }'); eq(1, v.value); @@ -158,7 +143,7 @@ class TestPython extends Test { function testOptionalEnumArguments() { var a1 = 1; var a2 = null; - switch(A("foo")) { + switch (A("foo")) { case A(i, b): a1 = i; a2 = b; @@ -172,11 +157,11 @@ class TestPython extends Test { function throwMe(arg:Dynamic) { return try { throw arg; - } catch(e:haxe.macro.Expr.ExprDef) { + } catch (e:haxe.macro.Expr.ExprDef) { 'ExprDef:$e'; - } catch(s:String) { + } catch (s:String) { 'String:$s'; - } catch(e:Dynamic) { + } catch (e:Dynamic) { 'Other:$e'; } } @@ -186,128 +171,127 @@ class TestPython extends Test { } /* - function testSys () { + function testSys () { - var p = new Process("/bin/ls", ["-l"]); + var p = new Process("/bin/ls", ["-l"]); - trace(p.stdout.readLine()); - trace(p.stdout.readLine()); - } - */ - - function testUnderscoreAndReflection () { - var x = { __v : 5 }; + trace(p.stdout.readLine()); + trace(p.stdout.readLine()); + } + */ + function testUnderscoreAndReflection() { + var x = {__v: 5}; eq(5, Reflect.field(x, "__v")); - var x = { ___b : 5 }; + var x = {___b: 5}; eq(5, Reflect.field(x, "___b")); - var x = { __iter__ : 5 }; + var x = {__iter__: 5}; eq(5, Reflect.field(x, "__iter__")); } - function testKwArgsAfterVarArgs () { - function test (va:VarArgs, kw:KwArgs) { + function testKwArgsAfterVarArgs() { + function test(va:VarArgs, kw:KwArgs) { var a = va.toArray(); - eq(1,a[0]); - eq(2,a[1]); - eq(1,kw.get("a", null)); + eq(1, a[0]); + eq(2, a[1]); + eq(1, kw.get("a", null)); } - var a = python.Lib.anonToDict({ "a" : 1}); - var x = [1,2]; - test(x,a); + var a = python.Lib.anonToDict({"a": 1}); + var x = [1, 2]; + test(x, a); } - function testSoftKeywords () { - function test (len:String, bytes:String) { - eq(len.length,bytes.length); + function testSoftKeywords() { + function test(len:String, bytes:String) { + eq(len.length, bytes.length); } test("x", "x"); } - function testKwArgsNativeNames () { - function test (?kw:KwArgs<{ @:native("default") var def:Int; }>) { + function testKwArgsNativeNames() { + function test(?kw:KwArgs<{@:native("default") var def:Int;}>) { eq(1, kw.typed().def); } - test({ def : 1}); + test({def: 1}); } - function testOptionalVarArgs () { - function test (?va:VarArgs, ?kw:KwArgs) { + function testOptionalVarArgs() { + function test(?va:VarArgs, ?kw:KwArgs) { var a = va.toArray(); - eq(0,a.length); + eq(0, a.length); } test(); } - function testOptionalKwArgs () { - function test (?kw:KwArgs) eq(0,kw.toDict().length); + function testOptionalKwArgs() { + function test(?kw:KwArgs) + eq(0, kw.toDict().length); test(); } - function testOptionalKwArgsAfterOptionalVarArgs () { - function test (?va:VarArgs, ?kw:KwArgs) { + function testOptionalKwArgsAfterOptionalVarArgs() { + function test(?va:VarArgs, ?kw:KwArgs) { var a = va.toArray(); - eq(1,a[0]); - eq(2,a[1]); + eq(1, a[0]); + eq(2, a[1]); eq(0, kw.toDict().length); } - var x = [1,2]; + var x = [1, 2]; test(x); - function test (?va:VarArgs, ?kw:KwArgs) { + function test(?va:VarArgs, ?kw:KwArgs) { var a = va.toArray(); - eq(0,a.length); - eq(1, kw.get("a",null)); + eq(0, a.length); + eq(1, kw.get("a", null)); } - var a = python.Lib.anonToDict({ "a" : 1}); + var a = python.Lib.anonToDict({"a": 1}); test(a); } - function testKwArgs () { - function x (args:KwArgs) { + function testKwArgs() { + function x(args:KwArgs) { var a = args.get("a", 0); var b = args.get("b", 0); return a + b; } - var a = python.Lib.anonToDict({ "a" : 1, "b" : 2}); - var res = x( a ); + var a = python.Lib.anonToDict({"a": 1, "b": 2}); + var res = x(a); eq(3, res); - var res2 = python.Syntax.callNamedUntyped(x, { a : 3, b : 5}); + var res2 = python.Syntax.callNamedUntyped(x, {a: 3, b: 5}); eq(8, res2); } - function testTypedKwArgs () { - function x (args:KwArgs<{ a : Int, b : Int}>) { + function testTypedKwArgs() { + function x(args:KwArgs<{a:Int, b:Int}>) { var x = args.typed(); return x.a + x.b; } - var a = { a : 1, b : 2}; - var res = x( a ); + var a = {a: 1, b: 2}; + var res = x(a); eq(3, res); - var res = x( { a : 1, b : 2} ); + var res = x({a: 1, b: 2}); eq(3, res); } function testNonLocal() { - try { } - catch (e:Dynamic) { + try {} catch (e:Dynamic) { e = 1; } noAssert(); @@ -319,10 +303,17 @@ class TestPython extends Test { var s2(null, set):String; var s3(get, set):String; - function get_s() return s; - function set_s2(s) return s2 = s; - function get_s3() return _s; - function set_s3(s) return _s = s; + function get_s() + return s; + + function set_s2(s) + return s2 = s; + + function get_s3() + return _s; + + function set_s3(s) + return _s = s; function testPropertyInit() { s += "a"; @@ -337,23 +328,22 @@ class TestPython extends Test { t((new B() is IA)); } - // Syntax Tests - function testPythonCodeStringInterpolation () { + function testPythonCodeStringInterpolation() { var z = 1; - var a = (Syntax.code('[{0}, {1}]', z, 2):Array); + var a = (Syntax.code('[{0}, {1}]', z, 2) : Array); eq(a[0], z); eq(a[1], 2); - function test2 (x:Int) { + function test2(x:Int) { x += 1; - return (Syntax.code("{0}", x):Int); + return (Syntax.code("{0}", x) : Int); } - function test3 (x:Int) { - return (Syntax.code('[{0}]', x):Array); + function test3(x:Int) { + return (Syntax.code('[{0}]', x) : Array); } var x = 1; @@ -364,13 +354,12 @@ class TestPython extends Test { eq("foo1bar", Syntax.code("'foo' + str({0}) + 'bar'", x)); - - function test4a (x:Int) { - return (Syntax.code("[{0}][0]", x+x):Int); + function test4a(x:Int) { + return (Syntax.code("[{0}][0]", x + x) : Int); } - function test4b (x:Int):String { - return Syntax.code('[{0}][0]', (function () return Std.string(x+x))() ); + function test4b(x:Int):String { + return Syntax.code('[{0}][0]', (function() return Std.string(x + x))()); } eq(2, test4a(1)); @@ -408,17 +397,16 @@ class TestPython extends Test { eq(t._5, 5); eq(t.length, 5); - var t = new Tuple([1,2,3]); + var t = new Tuple([1, 2, 3]); eq(t[0], 1); eq(t[1], 2); eq(t[2], 3); eq(t.length, 3); } - function testVectorEquality() - { + function testVectorEquality() { var v = new haxe.ds.Vector(1); var v2 = v.copy(); eq(v == v2, false); } -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue5351.hx b/tests/unit/src/unit/issues/Issue5351.hx index 43b5a4cfb6e..ea2b76d0112 100644 --- a/tests/unit/src/unit/issues/Issue5351.hx +++ b/tests/unit/src/unit/issues/Issue5351.hx @@ -1,4 +1,5 @@ package unit.issues; + import scripthost.Issue5351; class Issue5351 extends Test { @@ -10,20 +11,20 @@ class Issue5351 extends Test { eq(scripthost.Issue5351.callDoTest1(t3), 'doTest1 override'); eq(scripthost.Issue5351.callDoTest2(t3), 'doTest2 override'); - eq(scripthost.Issue5351_2.callDoTest1(t3), 'doTest1 override'); - eq(scripthost.Issue5351_2.callDoTest2(t3), 'doTest2 override'); - eq(scripthost.Issue5351_2.callDoTest3(t3), 'doTest3 override'); + eq(Issue5351_2.callDoTest1(t3), 'doTest1 override'); + eq(Issue5351_2.callDoTest2(t3), 'doTest2 override'); + eq(Issue5351_2.callDoTest3(t3), 'doTest3 override'); - var t3 = new Issue5351_3(); + var t3 = new Issue5351_3(); eq(t3.doTest1(), 'doTest1 override'); eq(t3.doTest2(), 'doTest2 override'); eq(t3.doTest3(), 'doTest3 override'); eq(scripthost.Issue5351.callDoTest1(t3), 'doTest1 override'); eq(scripthost.Issue5351.callDoTest2(t3), 'doTest2 override'); - eq(scripthost.Issue5351_2.callDoTest1(t3), 'doTest1 override'); - eq(scripthost.Issue5351_2.callDoTest2(t3), 'doTest2 override'); - eq(scripthost.Issue5351_2.callDoTest3(t3), 'doTest3 override'); + eq(Issue5351_2.callDoTest1(t3), 'doTest1 override'); + eq(Issue5351_2.callDoTest2(t3), 'doTest2 override'); + eq(Issue5351_2.callDoTest3(t3), 'doTest3 override'); eq(t3.doTest4(), 'doTest4'); } @@ -42,7 +43,7 @@ class Issue5351 extends Test { return 'doTest3 override'; } - public function doTest4() { + public function doTest4() { return 'doTest4'; - } + } } diff --git a/tests/unit/src/unit/issues/Issue9197.hx b/tests/unit/src/unit/issues/Issue9197.hx new file mode 100644 index 00000000000..b5729937163 --- /dev/null +++ b/tests/unit/src/unit/issues/Issue9197.hx @@ -0,0 +1,12 @@ +package unit.issues; + +import String.fromCharCode as Math; +import Math; +import utest.Assert; + +class Issue9197 extends Test { + function testFielsVsTypeImport() { + feq(1.0, Math.abs(-1)); + Assert.pass(); + } +}