瀏覽代碼

retain current return type constraints

Simon Krajewski 11 年之前
父節點
當前提交
b81afd746b
共有 3 個文件被更改,包括 41 次插入7 次删除
  1. 0 1
      tests/unit/MyAbstract.hx
  2. 2 2
      tests/unit/TestType.hx
  3. 39 4
      typer.ml

+ 0 - 1
tests/unit/MyAbstract.hx

@@ -203,7 +203,6 @@ abstract MyString(String) from String to String {
 	@:op(A + B) static public function add(lhs:MyString, rhs:MyString):MyString;
 	@:op(A + B) static public function addInt(lhs:MyString, rhs:Int):MyString;
 	@:op(A + B) static public function addBool(lhs:MyString, rhs:Bool):Bool;
-	@:op(A - B) static public function sub(lhs:MyString, rhs:MyString):MyString;
 }
 
 class ClassWithHashCode {

+ 2 - 2
tests/unit/TestType.hx

@@ -783,9 +783,9 @@ class TestType extends Test {
 		t(Std.is(msum2, String));
 
 		// operation is defined, but return type is not compatible
-		//t(typeError(ms1 + true));
+		t(typeError(ms1 + true));
 		// operation is not defined
-		//t(typeError(ms1 - ms2));
+		t(typeError(ms1 - ms2));
 	}
 
 	function testAbstractUnop() {

+ 39 - 4
typer.ml

@@ -2111,6 +2111,14 @@ let rec type_binop ctx op e1 e2 is_assign_op with_type p =
 	| OpAssignOp _ ->
 		assert false
 	in
+	let rec expected_result_type = function
+		| OpAdd | OpSub | OpMult | OpDiv | OpMod -> ctx.t.tfloat
+		| OpGt | OpGte | OpLt | OpLte | OpEq | OpNotEq | OpBoolAnd | OpBoolOr -> ctx.t.tbool
+		| OpAnd | OpOr | OpXor | OpUShr | OpShr | OpShl -> ctx.t.tint
+		| OpArrow -> t_dynamic
+		| OpAssignOp op -> expected_result_type op
+		| OpInterval | OpAssign -> assert false
+	in
 	let find_overload a c tl =
 		let map = apply_params a.a_params tl in
 		(* special case for == and !=: if the second type is a monomorph, assume that we want to unify
@@ -2131,7 +2139,7 @@ let rec type_binop ctx op e1 e2 is_assign_op with_type p =
 				loop ol
 			| (op_cf,cf) :: ol ->
 				begin match follow cf.cf_type with
-					| TFun([(_,_,t1);(_,_,t2)],ret) ->
+					| TFun([(_,_,t1);(_,_,t2)],tret) ->
 						let map_arguments () =
 							let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
 							let map t = map (apply_params cf.cf_params monos t) in
@@ -2140,9 +2148,36 @@ let rec type_binop ctx op e1 e2 is_assign_op with_type p =
 							monos,t1,t2
 						in
 						let make e1 e2 =
-							if cf.cf_expr = None then mk_cast (Codegen.binop op e1 e2 ret p) ret p
-							else begin
-								let e = make_static_call ctx c cf map [e1;e2] ret p in
+							if cf.cf_expr = None then begin
+								if not (Meta.has Meta.CoreType a.a_meta) then begin
+									(* for non core-types we require that the return type is compatible to the native result type *)
+									let t_expected = expected_result_type op_cf in
+									begin try
+										unify_raise ctx tret t_expected p
+									with Error (Unify _,_) ->
+										let invalid_return () =
+											let s_expected = match op with
+												| OpAdd | OpAssignOp OpAdd -> "String or "
+												| _ -> ""
+											in
+											let pctx = print_context() in
+											let st = s_type pctx in
+											error (Printf.sprintf "The result of this operation (%s%s) is not compatible with declared return type %s" s_expected (st t_expected) (st tret)) p
+										in
+										match op with
+											| OpAdd | OpAssignOp OpAdd ->
+												begin try
+													unify_raise ctx tret ctx.t.tstring p
+												with Error (Unify _,_) ->
+													invalid_return()
+												end
+											| _ ->
+												invalid_return()
+									end;
+								end;
+								mk_cast (Codegen.binop op e1 e2 tret p) tret p
+							end else begin
+								let e = make_static_call ctx c cf map [e1;e2] tret p in
 								if is_assign_op && op_cf = op then (mk (TMeta((Meta.RequiresAssign,[],p),e)) e.etype e.epos)
 								else e
 							end