Browse Source

allow abstract setters (fixed issue #1550)

Simon Krajewski 12 years ago
parent
commit
07ffcc41c4
4 changed files with 37 additions and 3 deletions
  1. 18 0
      tests/unit/MyAbstract.hx
  2. 6 0
      tests/unit/TestBasetypes.hx
  3. 2 2
      typeload.ml
  4. 11 1
      typer.ml

+ 18 - 0
tests/unit/MyAbstract.hx

@@ -220,4 +220,22 @@ abstract MyAbstractClosure(String){
 	public inline function setVal(v) {
 	public inline function setVal(v) {
 		this = v;
 		this = v;
 	}
 	}
+}
+
+abstract MyAbstractSetter(Dynamic) {
+	
+	public var value(get,set):String;
+	
+	public inline function new() {
+		this = {};
+	}
+	
+	inline function get_value() {
+		return this.value;
+	}
+	
+	inline function set_value(s:String) {
+		this.value = s;
+		return s;
+	}
 }
 }

+ 6 - 0
tests/unit/TestBasetypes.hx

@@ -423,4 +423,10 @@ class TestBasetypes extends Test {
 		eq("aaaaa", r * "a");
 		eq("aaaaa", r * "a");
 		eq("aaaaa", "a" * r);
 		eq("aaaaa", "a" * r);
 	}
 	}
+	
+	function testAbstractSetter() {
+		var as = new unit.MyAbstract.MyAbstractSetter();
+		as.value = "foo";
+		eq(as.value, "foo");
+	}
 }
 }

+ 2 - 2
typeload.ml

@@ -130,12 +130,12 @@ let make_module ctx mpath file tdecls loadp =
 					let stat = List.mem AStatic f.cff_access in
 					let stat = List.mem AStatic f.cff_access in
 					let p = f.cff_pos in
 					let p = f.cff_pos in
 					match f.cff_kind with
 					match f.cff_kind with
-					| FProp ("get","never",_,_) ->
+					| FProp (("get" | "never"),("set" | "never"),_,_) ->
 						(* TODO: hack to avoid issues with abstract property generation on As3 *)
 						(* TODO: hack to avoid issues with abstract property generation on As3 *)
 						if Common.defined ctx.com Define.As3 then f.cff_meta <- (Meta.Extern,[],p) :: f.cff_meta;
 						if Common.defined ctx.com Define.As3 then f.cff_meta <- (Meta.Extern,[],p) :: f.cff_meta;
 						{ f with cff_access = AStatic :: f.cff_access; cff_meta = (Meta.Impl,[],p) :: f.cff_meta }
 						{ f with cff_access = AStatic :: f.cff_access; cff_meta = (Meta.Impl,[],p) :: f.cff_meta }
 					| FProp _ when not stat ->
 					| FProp _ when not stat ->
-						display_error ctx "Member property on abstract must be (get,never)" p;
+						display_error ctx "Member property accessors must be get/set or never" p;
 						f
 						f
 					| FVar _ when not stat ->
 					| FVar _ when not stat ->
 						display_error ctx "Cannot declare member variable in abstract" p;
 						display_error ctx "Cannot declare member variable in abstract" p;

+ 11 - 1
typer.ml

@@ -1098,6 +1098,13 @@ and type_field ctx e i p mode =
 				let r = match follow t with TFun(_,r) -> r | _ -> raise Not_found in
 				let r = match follow t with TFun(_,r) -> r | _ -> raise Not_found in
 				let ef = field_expr f r in
 				let ef = field_expr f r in
 				AKExpr(make_call ctx ef [e] r p)
 				AKExpr(make_call ctx ef [e] r p)
+			| MSet, Var {v_write = AccCall s} ->
+				let f = PMap.find s c.cl_statics in
+				let t = field_type f in
+				let ef = field_expr f t in
+				AKUsing (ef,c,f,e)
+			| MGet, Var {v_read = AccNever} ->
+				AKNo f.cf_name
 			| (MGet | MCall), _ ->
 			| (MGet | MCall), _ ->
 				let t = field_type f in
 				let t = field_type f in
 				let ef = field_expr f t in
 				let ef = field_expr f t in
@@ -1311,7 +1318,10 @@ let rec type_binop ctx op e1 e2 is_assign_op p =
 			let et = type_module_type ctx (TClassDecl c) None p in
 			let et = type_module_type ctx (TClassDecl c) None p in
 			let ef = mk (TField(et,(FStatic(c,cf)))) tf p in
 			let ef = mk (TField(et,(FStatic(c,cf)))) tf p in
 			make_call ctx ef [ebase;ekey;e2] r p
 			make_call ctx ef [ebase;ekey;e2] r p
-		| AKInline _ | AKUsing _ | AKMacro _ ->
+		| AKUsing(ef,_,_,et) ->
+			(* this must be an abstract setter *)
+			make_call ctx ef [et;e2] e2.etype p
+		| AKInline _ | AKMacro _ ->
 			assert false)
 			assert false)
 	| OpAssignOp op ->
 	| OpAssignOp op ->
 		(match type_access ctx (fst e1) (snd e1) MSet with
 		(match type_access ctx (fst e1) (snd e1) MSet with