[java/cs] overload selection algorithm

fixed issue #1755

codegen.ml

@@ -1968,3 +1968,176 @@ let default_cast ?(vtmp="$t") com e texpr t p =
 	let exc = mk (TThrow (mk (TConst (TString "Class cast error")) api.tstring p)) t p in
 	let check = mk (TIf (mk_parent is,mk (TCast (vexpr,None)) t p,Some exc)) t p in
 	mk (TBlock [var;check;vexpr]) t p
+
+(** Overload resolution **)
+module Overloads =
+struct
+	let rec simplify_t t = match t with
+		| TInst _ | TEnum _ | TAbstract({ a_impl = None }, _) ->
+			t
+		| TAbstract(a,tl) -> simplify_t (Abstract.get_underlying_type a tl)
+		| TType(({ t_path = [],"Null" } as t), [t2]) -> (match simplify_t t2 with
+			| (TAbstract({ a_impl = None }, _) | TEnum _ as t2) -> TType(t, [simplify_t t2])
+			| t2 -> t2)
+		| TType(t, tl) ->
+			simplify_t (apply_params t.t_types tl t.t_type)
+		| TMono r -> (match !r with
+			| Some t -> simplify_t t
+			| None -> t_dynamic)
+		| TAnon _ -> t_dynamic
+		| TDynamic _ -> t
+		| TLazy f -> simplify_t (!f())
+		| TFun _ -> t
+
+	(* rate type parameters *)
+	let rate_tp tlfun tlarg =
+		let acc = ref 0 in
+		List.iter2 (fun f a -> if not (type_iseq f a) then incr acc) tlfun tlarg;
+		!acc
+
+	let rec rate_conv cacc tfun targ =
+		match simplify_t tfun, simplify_t targ with
+		| TInst({ cl_interface = true } as cf, tlf), TInst(ca, tla) ->
+			(* breadth-first *)
+			let stack = ref [0,ca,tla] in
+			let cur = ref (0, ca,tla) in
+			let rec loop () =
+				match !stack with
+				| [] -> (let acc, ca, tla = !cur in match ca.cl_super with
+					| None -> raise Not_found
+					| Some (sup,tls) ->
+						cur := (acc+1,sup,List.map (apply_params ca.cl_types tla) tls);
+						stack := [!cur];
+						loop())
+				| (acc,ca,tla) :: _ when ca == cf ->
+					acc,tla
+				| (acc,ca,tla) :: s ->
+					stack := s @ List.map (fun (c,tl) -> (acc+1,c,List.map (apply_params ca.cl_types tla) tl)) ca.cl_implements;
+					loop()
+			in
+			let acc, tla = loop() in
+			(cacc + acc, rate_tp tlf tla)
+		| TInst(cf,tlf), TInst(ca,tla) ->
+			let rec loop acc ca tla =
+				if cf == ca then
+					acc, tla
+				else match ca.cl_super with
+				| None -> raise Not_found
+				| Some(sup,stl) ->
+					loop (acc+1) sup (List.map (apply_params ca.cl_types tla) stl)
+			in
+			let acc, tla = loop 0 ca tla in
+			(cacc + acc, rate_tp tlf tla)
+		| TEnum(ef,tlf), TEnum(ea, tla) ->
+			if ef != ea then raise Not_found;
+			(cacc, rate_tp tlf tla)
+		| TDynamic _, TDynamic _ ->
+			(cacc, 0)
+		| TDynamic _, _ ->
+			(max_int, 0) (* a function with dynamic will always be worst of all *)
+		| TAbstract({ a_impl = None }, _), TDynamic _ ->
+			(cacc + 2, 0) (* a dynamic to a basic type will have an "unboxing" penalty *)
+		| _, TDynamic _ ->
+			(cacc + 1, 0)
+		| TAbstract(af,tlf), TAbstract(aa,tla) ->
+			(if af == aa then
+				(cacc, rate_tp tlf tla)
+			else
+				let ret = ref None in
+				if List.exists (fun (t,_) -> try
+					ret := Some (rate_conv (cacc+1) (apply_params af.a_types tlf t) targ);
+					true
+				with | Not_found ->
+					false
+				) af.a_from then
+					Option.get !ret
+			else
+				if List.exists (fun (t,_) -> try
+					ret := Some (rate_conv (cacc+1) tfun (apply_params aa.a_types tla t));
+					true
+				with | Not_found ->
+					false
+				) aa.a_to then
+					Option.get !ret
+			else
+				raise Not_found)
+		| TType({ t_path = [], "Null" }, [tf]), TType({ t_path = [], "Null" }, [ta]) ->
+			rate_conv (cacc+0) tf ta
+		| TType({ t_path = [], "Null" }, [tf]), ta ->
+			rate_conv (cacc+1) tf ta
+		| tf, TType({ t_path = [], "Null" }, [ta]) ->
+			rate_conv (cacc+1) tf ta
+		| TFun _, TFun _ -> (* unify will make sure they are compatible *)
+			cacc,0
+		| tfun,targ ->
+			raise Not_found
+
+	let is_best arg1 arg2 =
+		(List.for_all2 (fun v1 v2 ->
+			v1 <= v2)
+		arg1 arg2) && (List.exists2 (fun v1 v2 ->
+			v1 < v2)
+		arg1 arg2)
+
+	let rec rm_duplicates acc ret = match ret with
+		| [] -> acc
+		| ( el, t ) :: ret when List.exists (fun (_,t2) -> type_iseq t t2) acc ->
+			rm_duplicates acc ret
+		| r :: ret ->
+			rm_duplicates (r :: acc) ret
+
+	let s_options rated =
+		String.concat ",\n" (List.map (fun ((_,t),rate) ->
+			"( " ^ (String.concat "," (List.map (fun (i,i2) -> string_of_int i ^ ":" ^ string_of_int i2) rate)) ^ " ) => " ^ (s_type (print_context()) t)
+		) rated)
+
+	let count_optionals elist =
+		List.fold_left (fun acc (_,is_optional) -> if is_optional then acc + 1 else acc) 0 elist
+
+	let rec fewer_optionals acc compatible = match acc, compatible with
+		| _, [] -> acc
+		| [], c :: comp -> fewer_optionals [c] comp
+		| (elist_acc, _) :: _, ((elist, _) as cur) :: comp ->
+			let acc_opt = count_optionals elist_acc in
+			let comp_opt = count_optionals elist in
+			if acc_opt = comp_opt then
+				fewer_optionals (cur :: acc) comp
+			else if acc_opt < comp_opt then
+				fewer_optionals acc comp
+			else
+				fewer_optionals [cur] comp
+
+	let reduce_compatible compatible = match fewer_optionals [] (rm_duplicates [] compatible) with
+		| [] -> [] | [v] -> [v]
+		| compatible ->
+			(* convert compatible into ( rate * compatible_type ) list *)
+			let rec mk_rate acc elist args = match elist, args with
+				| [], [] -> acc
+				| (_,true) :: elist, _ :: args -> mk_rate acc elist args
+				| (e,false) :: elist, (n,o,t) :: args ->
+					mk_rate (rate_conv 0 t e.etype :: acc) elist args
+				| _ -> assert false
+			in
+
+			let rated = ref [] in
+			List.iter (function
+				| (elist,TFun(args,ret)) -> (try
+					rated := ( (elist,TFun(args,ret)), mk_rate [] elist args ) :: !rated
+					with | Not_found ->  ())
+				| _ -> assert false
+			) compatible;
+
+			let rec loop best rem = match best, rem with
+				| _, [] -> best
+				| [], r1 :: rem -> loop [r1] rem
+				| (bover, bargs) :: b1, (rover, rargs) :: rem ->
+					if is_best bargs rargs then
+						loop best rem
+					else if is_best rargs bargs then
+						loop (loop b1 [rover,rargs]) rem
+					else (* equally specific *)
+						loop ( (rover,rargs) :: best ) rem
+			in
+
+			List.map fst (loop [] !rated)
+end;;

gencommon.ml

@@ -514,7 +514,7 @@ type generator_ctx =
 
   (* cast detection helpers / settings *)
   (* this is a cache for all field access types *)
-  greal_field_types : (path * string, (tclass_field (* does the cf exist *) * t (*cf's type in relation to current class type params *) * tclass (* declared class *) ) option) Hashtbl.t;
+  greal_field_types : (path * string, (tclass_field (* does the cf exist *) * t (*cf's type in relation to current class type params *) * t * tclass (* declared class *) ) option) Hashtbl.t;
   (* this function allows any code to handle casts as if it were inside the cast_detect module *)
   mutable ghandle_cast : t->t->texpr->texpr;
   (* when an unsafe cast is made, we can warn the user *)
@@ -1213,6 +1213,52 @@ type tfield_access =
   | FDynamicField of t
   | FNotFound
 
+let find_first_declared_field gen orig_cl ?exact_field field =
+  let chosen = ref None in
+  let is_overload = ref false in
+  let rec loop_cl depth c tl tlch =
+    (try
+      let ret = PMap.find field c.cl_fields in
+      if Meta.has Meta.Overload ret.cf_meta then is_overload := true;
+      match !chosen, exact_field with
+      | Some(d,_,_,_,_), _ when depth <= d -> ()
+      | _, None ->
+        chosen := Some(depth,ret,c,tl,tlch)
+      | _, Some f2 ->
+        List.iter (fun f ->
+          let declared_t = apply_params c.cl_types tl f.cf_type in
+          if Typeload.same_overload_args declared_t f2.cf_type f f2 then
+            chosen := Some(depth,f,c,tl,tlch)
+        ) (ret :: ret.cf_overloads)
+    with | Not_found -> ());
+    (match c.cl_super with
+    | Some (sup,stl) ->
+      let tl = List.map (apply_params c.cl_types tl) stl in
+      let stl = gen.greal_type_param (TClassDecl sup) stl in
+      let tlch = List.map (apply_params c.cl_types tlch) stl in
+      loop_cl (depth+1) sup tl tlch
+    | None -> ());
+    if c.cl_interface then
+      List.iter (fun (sup,stl) ->
+        let tl = List.map (apply_params c.cl_types tl) stl in
+        let stl = gen.greal_type_param (TClassDecl sup) stl in
+        let tlch = List.map (apply_params c.cl_types tlch) stl in
+        loop_cl (depth+1) sup tl tlch
+      ) c.cl_implements
+  in
+  loop_cl 0 orig_cl (List.map snd orig_cl.cl_types) (List.map snd orig_cl.cl_types);
+  match !chosen with
+  | None -> None
+  | Some(_,f,c,tl,tlch) ->
+    if !is_overload && not (Meta.has Meta.Overload f.cf_meta) then
+      f.cf_meta <- (Meta.Overload,[],f.cf_pos) :: f.cf_meta;
+    let declared_t = apply_params c.cl_types tl f.cf_type in
+    let params_t = apply_params c.cl_types tlch f.cf_type in
+    let actual_t = match follow params_t with
+    | TFun(args,ret) -> TFun(List.map (fun (n,o,t) -> (n,o,gen.greal_type t)) args, gen.greal_type ret)
+    | _ -> gen.greal_type params_t in
+    Some(f,actual_t,declared_t,params_t,c,tl,tlch)
+
 let field_access gen (t:t) (field:string) : (tfield_access) =
   (*
     t can be either an haxe-type as a real-type;
@@ -1245,45 +1291,21 @@ let field_access gen (t:t) (field:string) : (tfield_access) =
 
       (* this is a hack for C#'s different generic types with same path *)
       let hashtbl_field = (String.concat "" (List.map (fun _ -> "]") cl.cl_types)) ^ field in
-      (try
-        match Hashtbl.find gen.greal_field_types (orig_cl.cl_path, hashtbl_field) with
-          | None -> not_found()
-          | Some (cf, actual_t, declared_cl) ->
-            FClassField(orig_cl, orig_params, declared_cl, cf, false, actual_t)
+      let types = try
+        Hashtbl.find gen.greal_field_types (orig_cl.cl_path, hashtbl_field)
       with | Not_found ->
-        let rec flatten_hierarchy cl acc =
-          match cl.cl_super with
-            | None -> acc
-            | Some (cl,super) -> flatten_hierarchy cl ((cl,super) :: acc)
+        let ret = find_first_declared_field gen cl field in
+        let ret = match ret with
+          | None -> None
+          | Some(cf,t,dt,_,cl,_,_) -> Some(cf,t,dt,cl)
         in
-
-        let hierarchy = flatten_hierarchy orig_cl [orig_cl, List.map snd orig_cl.cl_types] in
-
-        let rec loop_find_cf acc =
-          match acc with
-            | [] ->
-              not_found()
-            | (cl,params) :: tl ->
-              (try
-                let cf = PMap.find field cl.cl_fields in
-                (* found *)
-                (* get actual type *)
-                let get_real_t = match cf.cf_kind with
-                  | Var _ -> (fun t -> gen.greal_type t)
-                  | _ -> (fun t ->
-                    let args, ret = get_fun t in
-                    TFun(List.map (fun (n,o,t) -> (n,o,gen.greal_type t)) args, gen.greal_type ret)
-                  )
-                in
-                let actual_t = List.fold_left (fun t (cl,params) -> apply_params cl.cl_types (gen.greal_type_param (TClassDecl cl) params) (get_real_t t)) cf.cf_type acc in
-                Hashtbl.add gen.greal_field_types (orig_cl.cl_path, hashtbl_field) (Some (cf, actual_t, cl));
-                FClassField(orig_cl, orig_params, cl, cf, false, actual_t)
-              with | Not_found ->
-                loop_find_cf tl
-              )
-        in
-        loop_find_cf hierarchy
-      )
+        Hashtbl.add gen.greal_field_types (orig_cl.cl_path, hashtbl_field) ret;
+        ret
+      in
+      (match types with
+          | None -> not_found()
+          | Some (cf, actual_t, _, declared_cl) ->
+            FClassField(orig_cl, orig_params, declared_cl, cf, false, actual_t))
     | TEnum _ | TAbstract _ ->
       (* enums have no field *) FNotFound
     | TAnon anon ->
@@ -5619,7 +5641,7 @@ struct
   *)
 
   (* match e.eexpr with | TCall( ({ eexpr = TField(ef, f) }) as e1, elist ) -> *)
-  let handle_type_parameter gen e e1 ef ~clean_ef f elist impossible_tparam_is_dynamic =
+  let handle_type_parameter gen e e1 ef ~clean_ef ~overloads_cast_to_base f elist impossible_tparam_is_dynamic =
     (* the ONLY way to know if this call has parameters is to analyze the calling field. *)
     (* To make matters a little worse, on both C# and Java only in some special cases that type parameters will be used *)
     (* Namely, when using reflection type parameters are useless, of course. This also includes anonymous types *)
@@ -5648,6 +5670,7 @@ struct
         | TInst(_,params) -> params
         | _ -> params in
         let ecall = get e in
+        let ef = ref ef in
         let is_overload = cf.cf_overloads <> [] || Meta.has Meta.Overload cf.cf_meta || (is_static && is_static_overload cl (field_name f)) in
         let cf, actual_t, error = match is_overload with
           | false ->
@@ -5659,24 +5682,44 @@ struct
                   let t, cf = List.find (fun (t,f) -> f == cf) overloads in
                   cf,t,false
                   with | Not_found -> cf,actual_t,true)
-          | true -> match f with
-          | FInstance(c,cf) | FClosure(Some c,cf) ->
-            (* get from overloads *)
-            (* FIXME: this is a workaround for issue #1743 . Uncomment this code after it was solved *)
-            (* let t, cf = List.find (fun (t,cf2) -> cf == cf2) (Typeload.get_overloads cl (field_name f)) in *)
-            (* cf, t, false *)
-            select_overload gen e1.etype (Typeload.get_overloads cl (field_name f)) cl.cl_types params
-          | FStatic(c,f) ->
-            (* workaround for issue #1743 *)
-            (* f,f.cf_type, false *)
-            select_overload gen e1.etype ((f.cf_type,f) :: List.map (fun f -> f.cf_type,f) f.cf_overloads) [] []
-          | _ ->
-            gen.gcon.warning "Overloaded classfield typed as anonymous" ecall.epos;
+          | true ->
+          let (cf, actual_t, error), is_static = match f with
+            | FInstance(c,cf) | FClosure(Some c,cf) ->
+              (* get from overloads *)
+              (* FIXME: this is a workaround for issue #1743 . Uncomment this code after it was solved *)
+              (* let t, cf = List.find (fun (t,cf2) -> cf == cf2) (Typeload.get_overloads cl (field_name f)) in *)
+              (* cf, t, false *)
+              select_overload gen e1.etype (Typeload.get_overloads cl (field_name f)) cl.cl_types params, false
+            | FStatic(c,f) ->
+              (* workaround for issue #1743 *)
+              (* f,f.cf_type, false *)
+              select_overload gen e1.etype ((f.cf_type,f) :: List.map (fun f -> f.cf_type,f) f.cf_overloads) [] [], true
+            | _ ->
+              gen.gcon.warning "Overloaded classfield typed as anonymous" ecall.epos;
+              (cf, actual_t, true), true
+          in
+          if not (is_static || error) then match find_first_declared_field gen cl ~exact_field:{ cf with cf_type = actual_t } cf.cf_name with
+          | Some(_,actual_t,_,_,declared_cl,tl,tlch) ->
+            if declared_cl != cl && overloads_cast_to_base then begin
+              let pos = (!ef).epos in
+              ef := {
+                eexpr = TCall(
+                  { eexpr = TLocal(alloc_var "__as__" t_dynamic); etype = t_dynamic; epos = pos },
+                  [!ef]);
+                etype = TInst(declared_cl,List.map (apply_params cl.cl_types params) tl);
+                epos = pos
+              }
+            end;
+            cf,actual_t,false
+          | None ->
+            gen.gcon.warning "Cannot find matching overload" ecall.epos;
             cf, actual_t, true
+          else
+            cf,actual_t,error
         in
         let error = error || (match follow actual_t with | TFun _ -> false | _ -> true) in
         if error then (* if error, ignore arguments *)
-          mk_cast ecall.etype { ecall with eexpr = TCall({ e1 with eexpr = TField(ef, f) }, elist ) }
+          mk_cast ecall.etype { ecall with eexpr = TCall({ e1 with eexpr = TField(!ef, f) }, elist ) }
         else begin
           (* infer arguments *)
           (* let called_t = TFun(List.map (fun e -> "arg",false,e.etype) elist, ecall.etype) in *)
@@ -5708,14 +5751,14 @@ struct
             ) applied args_ft in
             { ecall with
               eexpr = TCall(
-                { e1 with eexpr = TField(ef, f) },
+                { e1 with eexpr = TField(!ef, f) },
                 elist);
             }, elist
           with | Invalid_argument("List.map2") ->
             gen.gcon.warning ("This expression may be invalid" ) ecall.epos;
-            { ecall with eexpr = TCall({ e1 with eexpr = TField(ef, f) }, elist) }, elist
+            { ecall with eexpr = TCall({ e1 with eexpr = TField(!ef, f) }, elist) }, elist
           in
-          let new_ecall = if fparams <> [] then gen.gparam_func_call new_ecall { e1 with eexpr = TField(ef, f) } fparams elist else new_ecall in
+          let new_ecall = if fparams <> [] then gen.gparam_func_call new_ecall { e1 with eexpr = TField(!ef, f) } fparams elist else new_ecall in
           handle_cast gen new_ecall (gen.greal_type ecall.etype) (gen.greal_type ret_ft)
         end
     | FClassField (cl,params,_,{ cf_kind = (Method MethDynamic | Var _) },_,actual_t) ->
@@ -5774,7 +5817,9 @@ struct
   (* end of type parameter handling *)
   (* ****************************** *)
 
-  let default_implementation gen ?(native_string_cast = true) maybe_empty_t impossible_tparam_is_dynamic =
+  (** overloads_cast_to_base argument will cast overloaded function types to the class that declared it. **)
+  (**     This is necessary for C#, and if true, will require the target to implement __as__, as a `quicker` form of casting **)
+  let default_implementation gen ?(native_string_cast = true) ?(overloads_cast_to_base = false) maybe_empty_t impossible_tparam_is_dynamic =
     let handle e t1 t2 = handle_cast gen e (gen.greal_type t1) (gen.greal_type t2) in
 
     let in_value = ref false in
@@ -5809,7 +5854,7 @@ struct
         | TBinop ( Ast.OpAdd, ( { eexpr = TCast(e1, _) } as e1c), e2 ) when native_string_cast && is_string e1c.etype && is_string e2.etype ->
           { e with eexpr = TBinop( Ast.OpAdd, run e1, run e2 ) }
         | TField(ef, f) ->
-          handle_type_parameter gen None e (run ef) ~clean_ef:ef f [] impossible_tparam_is_dynamic
+          handle_type_parameter gen None e (run ef) ~clean_ef:ef ~overloads_cast_to_base:overloads_cast_to_base f [] impossible_tparam_is_dynamic
         | TArrayDecl el ->
           let et = e.etype in
           let base_type = match follow et with
@@ -5823,7 +5868,7 @@ struct
         | TCall( ({ eexpr = TLocal v } as local), params ) when String.get v.v_name 0 = '_' && String.get v.v_name 1 = '_' && Hashtbl.mem gen.gspecial_vars v.v_name ->
           { e with eexpr = TCall(local, List.map run params) }
         | TCall( ({ eexpr = TField(ef, f) }) as e1, elist ) ->
-          handle_type_parameter gen (Some e) (e1) (run ef) ~clean_ef:ef f (List.map run elist) impossible_tparam_is_dynamic
+          handle_type_parameter gen (Some e) (e1) (run ef) ~clean_ef:ef ~overloads_cast_to_base:overloads_cast_to_base f (List.map run elist) impossible_tparam_is_dynamic
 
         (* the TNew and TSuper code was modified at r6497 *)
         | TCall( { eexpr = TConst TSuper } as ef, eparams ) ->
@@ -5965,7 +6010,6 @@ struct
 
 end;;
 
-
 (* ******************************************* *)
 (* Reflection-enabling Class fields *)
 (* ******************************************* *)
@@ -10021,6 +10065,47 @@ struct
           List.iter loop_f iface.cl_ordered_fields
         in
         List.iter (fun (iface,itl) -> loop_iface iface itl) c.cl_implements;
+        (* now go through all overrides, and find those that are overloads and have actual_t <> t *)
+        let rec check_f f =
+          (* find the first declared field *)
+          match find_first_declared_field gen c ~exact_field:f f.cf_name with
+          | Some(f2,actual_t,_,t,declared_cl,_,_)
+            when not (Typeload.same_overload_args actual_t (get_real_fun gen f.cf_type) f2 f) ->
+              (* create another field with the requested type *)
+              let f3 = mk_class_field f.cf_name t f.cf_public f.cf_pos f.cf_kind f.cf_params in
+              let p = f.cf_pos in
+              let old_args, old_ret = get_fun f.cf_type in
+              let args, ret = get_fun t in
+              let tf_args = List.map (fun (n,o,t) -> alloc_var n t, None) args in
+              f3.cf_expr <- Some {
+                eexpr = TFunction({
+                  tf_args = tf_args;
+                  tf_type = ret;
+                  tf_expr = mk_block (mk_return (mk_cast ret {
+                    eexpr = TCall(
+                      {
+                        eexpr = TField(
+                          { eexpr = TConst TThis; etype = TInst(c, List.map snd c.cl_types); epos = p },
+                          FInstance(c,f));
+                        etype = f.cf_type;
+                        epos = p
+                      },
+                      List.map2 (fun (v,_) (_,_,t) -> mk_cast t (mk_local v p)) tf_args old_args);
+                    etype = old_ret;
+                    epos = p
+                  }))
+                });
+                etype = t;
+                epos = p;
+              };
+              gen.gafter_filters_ended <- ((fun () ->
+                f.cf_overloads <- f3 :: f.cf_overloads;
+              ) :: gen.gafter_filters_ended);
+              f3
+          | _ -> f
+        in
+        if not c.cl_extern then
+          c.cl_overrides <- List.map (fun f -> if Meta.has Meta.Overload f.cf_meta then check_f f else f) c.cl_overrides;
         md
       | _ -> md
     in

gencs.ml

@@ -1013,6 +1013,12 @@ let configure gen =
           write w " as ";
           write w (md_s md);
           write w " )"
+        | TCall ({ eexpr = TLocal( { v_name = "__as__" } ) }, [ expr ] ) ->
+          write w "( ";
+          expr_s w expr;
+          write w " as ";
+          write w (t_s e.etype);
+          write w " )";
         | TCall ({ eexpr = TLocal( { v_name = "__cs__" } ) }, [ { eexpr = TConst(TString(s)) } ] ) ->
           write w s
         | TCall ({ eexpr = TLocal( { v_name = "__unsafe__" } ) }, [ e ] ) ->
@@ -2188,7 +2194,7 @@ let configure gen =
     get_typeof e
   ));
 
-  CastDetect.configure gen (CastDetect.default_implementation gen (Some (TEnum(empty_e, []))) false ~native_string_cast:false);
+  CastDetect.configure gen (CastDetect.default_implementation gen (Some (TEnum(empty_e, []))) false ~native_string_cast:false ~overloads_cast_to_base:true);
 
   (*FollowAll.configure gen;*)
 

std/java/_std/Date.hx

@@ -32,7 +32,9 @@ import haxe.Int64;
 	**/
 	public function new(year : Int, month : Int, day : Int, hour : Int, min : Int, sec : Int ) : Void
 	{
-		date = new java.util.Date(year != 0 ? year - 1900 : 0, month, day, hour, min, sec);
+		//issue #1769
+		year = year != 0 ? year - 1900 : 0;
+		date = new java.util.Date(year, month, day, hour, min, sec);
 	}
 
 	/**
@@ -167,4 +169,4 @@ import haxe.Int64;
 				throw "Invalid date format : " + s;
 		}
 	}
-}
+}

std/java/_std/StringBuf.hx

@@ -31,7 +31,9 @@ class StringBuf {
 	public function add( x : Dynamic ) : Void {
 		if (Std.is(x, Int))
 		{
-			b.append(cast(x, Int));
+			var x:Int = x;
+			var xd:Dynamic = x;
+			b.append(xd);
 		} else {
 			b.append(x);
 		}

tests/unit/Test.hx

@@ -251,6 +251,9 @@ class Test #if swf_mark implements mt.Protect #end {
 			#if php
 			new TestPhp(),
 			#end
+			#if (java || cs)
+			new TestOverloads(),
+			#end
 			#if ((dce == "full") && !interp && !as3)
 			new TestDCE(),
 			#end

tests/unit/TestJava.hx

@@ -4,140 +4,9 @@ import haxe.test.Base;
 import haxe.test.Base.Base_InnerClass;
 
 #if java
-class BaseJava implements NormalInterface
-{
-	public var i:Int;
-	public var s:String;
-	public var f:Float;
-
-	@:overload public function new(i:Int):Void
-	{
-		this.i = i;
-	}
-
-	@:overload public function new(s:String):Void
-	{
-		this.s = s;
-	}
-
-	@:overload public function new(f:Float):Void
-	{
-		this.f = f;
-	}
-
-	@:overload public function someField(b:haxe.io.Bytes):Int
-	{
-		return 0;
-	}
-
-	@:overload public function someField(i:Int):Int
-	{
-		return 1;
-	}
-
-	@:overload public function someField(s:String):Int
-	{
-		return 2;
-	}
-
-	@:overload public function someField(s:Bool):Int
-	{
-		return -1;
-	}
-}
-
-class ChildJava extends BaseJava implements OverloadedInterface
-{
-	public var initialized = 10;
-
-	@:overload public function new(b:haxe.io.Bytes)
-	{
-		super(b.toString());
-	}
-
-	@:overload public function new(i:Int)
-	{
-		super(i + 1);
-	}
-
-	@:overload public function someField(f:Float):Int
-	{
-		return 3;
-	}
-
-	@:overload override public function someField(b:haxe.io.Bytes)
-	{
-		return 2;
-	}
-}
-
-class ChildJava2<T> extends ChildJava
-{
-	public var initialized2 = "20";
-
-	@:overload public function new(x:Float)
-	{
-		super(Std.int(x));
-	}
-	@:overload private function new(b:haxe.io.Bytes)
-	{
-		super(b);
-	}
-
-	@:overload override public function someField(f:Float):Int
-	{
-		return 50;
-	}
-
-	@:overload public function someField(t:T):T
-	{
-		return t;
-	}
-
-	@:overload public function someField(c:Class<T>):Int
-	{
-		return 51;
-	}
-}
-
-class ChildJava3<A, T : BaseJava> extends ChildJava2<T>
-{
-	public var initialized3 = true;
-
-	@:overload override public function someField(t:T):T
-	{
-		return null;
-	}
-
-	@:overload public function someField<Z>(a:A, t:T, z:Z):Z
-	{
-		return z;
-	}
-
-	@:overload public function someField(a:A, c:Int):Int
-	{
-		return 52;
-	}
-}
-
-class ChildJava4<X, Y, Z : ChildJava2<Dynamic>> extends ChildJava3<Y, Z>
-{
-}
-
-interface NormalInterface
-{
-	function someField(i:Bool):Int;
-}
-
-interface OverloadedInterface extends NormalInterface
-{
-	@:overload function someField(s:String):Int;
-	@:overload function someField(f:Float):Int;
-}
-
 class TestJava extends Test
 {
-  function textException()
+  function testException()
   {
     var native = new NativeClass();
     var hx:NativeClass = new HxClass();
@@ -151,54 +20,6 @@ class TestJava extends Test
     catch(e:Dynamic) throw e; //shouldn't throw any exception
   }
 
-	function testOverload()
-	{
-		var base = new BaseJava(1);
-		eq(base.i, 1);
-		eq(new BaseJava("test").s, "test");
-		eq(base.someField(Bytes.ofString("test")), 0);
-		eq(base.someField(0), 1);
-		eq(base.someField("test"), 2);
-		eq(base.someField(true), -1);
-
-		eq(new ChildJava(4).i, 5);
-		var child = new ChildJava(Bytes.ofString("a"));
-		eq(child.s, "a");
-		eq(child.someField("test") , 2);
-		eq(child.someField(Bytes.ofString("a")), 2);
-		eq(child.someField(22.2), 3);
-		eq(new ChildJava(25).i, 26);
-		eq(child.initialized, 10);
-		eq(new ChildJava(100).initialized, 10);
-
-		var child:OverloadedInterface = child;
-		eq(child.someField("test"), 2);
-		eq(child.someField(22.2), 3);
-		eq(child.someField(true), -1);
-
-		var child:NormalInterface = child;
-		eq(child.someField(true), -1);
-
-		var child:ChildJava2<ChildJava2<Dynamic>> = new ChildJava2(22.5);
-		eq(child.i, 23);
-		eq(child.someField(22.5), 50);
-		eq(child.someField(child), child);
-		eq(child.someField(ChildJava2), 51);
-		eq(child.someField(true), -1);
-		eq(child.initialized2, "20");
-
-		var child:ChildJava3<Bool, BaseJava> = new ChildJava3(Bytes.ofString("test"));
-		eq(child.s, "test");
-		eq(child.someField(base), null);
-		eq(child.someField(true, child, 99), 99);
-		eq(child.someField(true, 10), 52);
-		eq(child.initialized3, true);
-
-		var child:ChildJava4<Int, Bool, ChildJava3<Dynamic, Dynamic>> = new ChildJava4(Bytes.ofString("test"));
-		eq(child.s, "test");
-		eq(child.someField(child), null);
-	}
-
 	function testHaxeKeywords()
 	{
 		eq(Base._inline, 42);

tests/unit/TestType.hx

@@ -465,7 +465,7 @@ class TestType extends Test {
 		//typeError(pcc.memberAnon( { y : 3. } ));
 
 		#if !(java || cs)
-		pcc.memberOverload("foo", "bar");
+		// pcc.memberOverload("foo", "bar");
 		#end
 		// TODO: this should not fail (overload accepts)
 		//pcc.memberOverload(1, [2]);

typeload.ml

@@ -642,8 +642,8 @@ let copy_meta meta_src meta_target sl =
 (** retrieves all overloads from class c and field i, as (Type.t * tclass_field) list *)
 let rec get_overloads c i =
 	let ret = try
-		let f = PMap.find i c.cl_fields in
-			(f.cf_type, f) :: (List.map (fun f -> f.cf_type, f) f.cf_overloads)
+			let f = PMap.find i c.cl_fields in
+			List.filter (fun (_,f) -> not (List.memq f c.cl_overrides)) ((f.cf_type, f) :: (List.map (fun f -> f.cf_type, f) f.cf_overloads))
 		with | Not_found -> []
 	in
 	match c.cl_super with
@@ -668,6 +668,17 @@ let same_overload_args t1 t2 f1 f2 =
         false)
     | _ -> assert false
 
+let check_overloads ctx c =
+	(* check if field with same signature was declared more than once *)
+	List.iter (fun f ->
+		if Meta.has Meta.Overload f.cf_meta then
+			List.iter (fun f2 ->
+				try
+					ignore (List.find (fun f3 -> f3 != f2 && same_overload_args f2.cf_type f3.cf_type f2 f3) (f :: f.cf_overloads));
+					display_error ctx ("Another overloaded field of same signature was already declared : " ^ f2.cf_name) f2.cf_pos
+				with | Not_found -> ()
+		) (f :: f.cf_overloads)) (c.cl_ordered_fields @ c.cl_ordered_statics)
+
 let check_overriding ctx c =
 	let p = c.cl_pos in
 	match c.cl_super with
@@ -719,13 +730,6 @@ let check_overriding ctx c =
 						display_error ctx msg p
 			in
 			if ctx.com.config.pf_overload && Meta.has Meta.Overload f.cf_meta then begin
-				(* check if field with same signature was declared more than once *)
-				List.iter (fun f2 ->
-					try
-						ignore (List.find (fun f3 -> f3 != f2 && same_overload_args f2.cf_type f3.cf_type f2 f3) (f :: f.cf_overloads));
-						display_error ctx ("Another overloaded field of same signature was already declared : " ^ f2.cf_name) f2.cf_pos
-					with | Not_found -> ()
-				) (f :: f.cf_overloads);
 				let overloads = get_overloads csup i in
 				List.iter (fun f ->
 					(* find the exact field being overridden *)
@@ -1264,6 +1268,7 @@ let init_class ctx c p context_init herits fields =
 	in
 
 	(match c.cl_super with None -> () | Some _ -> delay ctx PForce (fun() -> check_overriding ctx c));
+	if ctx.com.config.pf_overload then delay ctx PForce (fun() -> check_overloads ctx c);
 
 	(* ----------------------- COMPLETION ----------------------------- *)
 

typer.ml

@@ -456,35 +456,53 @@ let unify_min ctx el =
 		(List.hd el).etype
 
 let rec unify_call_params ctx ?(overloads=None) cf el args r p inline =
-	let overloads = match cf, overloads with
-		| Some(TInst(c,pl),f), None when ctx.com.config.pf_overload ->
-				let overloads = Typeload.get_overloads c f.cf_name in
+  (* 'overloads' will carry a ( return_result ) list, called 'compatible' *)
+  (* it's used to correctly support an overload selection algorithm *)
+	let overloads, compatible = match cf, overloads with
+		| Some(TInst(c,pl),f), None when ctx.com.config.pf_overload && Meta.has Meta.Overload f.cf_meta ->
+				let overloads = List.filter (fun (_,f2) -> not (f == f2)) (Typeload.get_overloads c f.cf_name) in
 				if overloads = [] then (* is static function *)
-					List.map (fun f -> f.cf_type, f) f.cf_overloads
+					List.map (fun f -> f.cf_type, f) f.cf_overloads, []
 				else
-					overloads
+					overloads, []
 		| Some(_,f), None ->
-				List.map (fun f -> f.cf_type, f) f.cf_overloads
+				List.map (fun f -> f.cf_type, f) f.cf_overloads, []
 		| _, Some s ->
 				s
-		| _ -> []
+		| _ -> [], []
 	in
-	let next() =
+	let next ?retval () =
+		let compatible = Option.map_default (fun r -> r :: compatible) compatible retval in
 		match cf, overloads with
 		| Some (TInst(c,pl),_), (ft,o) :: l ->
+			let o = { o with cf_type = ft } in
 			let args, ret = (match follow (apply_params c.cl_types pl (field_type ctx c pl o p)) with (* I'm getting non-followed types here. Should it happen? *)
 				| TFun (tl,t) -> tl, t
 				| _ -> assert false
 			) in
-			Some (unify_call_params ctx ~overloads:(Some l) (Some (TInst(c,pl),{ o with cf_type = ft })) el args ret p inline)
-		| Some (t,_), (_,o) :: l ->
+			Some (unify_call_params ctx ~overloads:(Some (l,compatible)) (Some (TInst(c,pl),o)) el args ret p inline)
+		| Some (t,_), (ft,o) :: l ->
+			let o = { o with cf_type = ft } in
 			let args, ret = (match Type.field_type o with
 				| TFun (tl,t) -> tl, t
 				| _ -> assert false
 			) in
-			Some (unify_call_params ctx ~overloads:(Some l) (Some (t, o)) el args ret p inline)
+			Some (unify_call_params ctx ~overloads:(Some (l,compatible)) (Some (t, o)) el args ret p inline)
 		| _ ->
-			None
+			match compatible with
+			| [] -> None
+			| [acc,t] -> Some (List.map fst acc, t)
+			| comp ->
+				match Codegen.Overloads.reduce_compatible compatible with
+				| [acc,t] -> Some (List.map fst acc, t)
+				| (acc,t) :: _ -> (* ambiguous overload *)
+					let name = match cf with | Some(_,f) -> "'" ^ f.cf_name ^ "' " | _ -> "" in
+					let format_amb = String.concat "\n" (List.map (fun (_,t) ->
+						"Function " ^ name ^ "with type " ^ (s_type (print_context()) t)
+					) compatible) in
+					display_error ctx ("This call is ambiguous between the following methods:\n" ^ format_amb) p;
+					Some (List.map fst acc,t)
+				| [] -> None
 	in
 	let fun_details() =
 		let format_arg = (fun (name,opt,_) -> (if opt then "?" else "") ^ name) in
@@ -505,7 +523,7 @@ let rec unify_call_params ctx ?(overloads=None) cf el args r p inline =
 	let rec no_opt = function
 		| [] -> []
 		| ({ eexpr = TConst TNull },true) :: l -> no_opt l
-		| l -> List.map fst l
+		| l -> l
 	in
 	let rec default_value t =
 		if is_pos_infos t then
@@ -518,10 +536,19 @@ let rec unify_call_params ctx ?(overloads=None) cf el args r p inline =
 	let rec loop acc l l2 skip =
 		match l , l2 with
 		| [] , [] ->
-			if not (inline && ctx.g.doinline) && not ctx.com.config.pf_pad_nulls then
+			let args,tf = if not (inline && ctx.g.doinline) && not ctx.com.config.pf_pad_nulls then
 				List.rev (no_opt acc), (TFun(args,r))
 			else
-				List.rev (List.map fst acc), (TFun(args,r))
+				List.rev (acc), (TFun(args,r))
+			in
+			if ctx.com.config.pf_overload then
+				match next ~retval:(args,tf) () with
+				| Some l -> l
+				| None ->
+					display_error ctx ("No overloaded function matches the arguments. Are the arguments correctly typed?") p;
+					List.map fst args, tf
+			else
+				List.map fst args, tf
 		| [] , (_,false,_) :: _ ->
 			error (List.fold_left (fun acc (_,_,t) -> default_value t :: acc) acc l2) "Not enough"
 		| [] , (name,true,t) :: l ->
@@ -4118,4 +4145,4 @@ let rec create com =
 unify_min_ref := unify_min;
 make_call_ref := make_call;
 get_constructor_ref := get_constructor;
-check_abstract_cast_ref := Codegen.Abstract.check_cast;
+check_abstract_cast_ref := Codegen.Abstract.check_cast;