فهرست منبع

ensure that the class in FInstance is the one the field is declared in

Nicolas Cannasse 12 سال پیش
والد
کامیت
18d0123ac9
3فایلهای تغییر یافته به همراه24 افزوده شده و 24 حذف شده
  1. 12 12
      type.ml
  2. 3 3
      typeload.ml
  3. 9 9
      typer.ml

+ 12 - 12
type.ml

@@ -860,17 +860,17 @@ let field_type f =
 let rec raw_class_field build_type c i =
 	try
 		let f = PMap.find i c.cl_fields in
-		build_type f , f
+		Some c, build_type f , f
 	with Not_found -> try (match c.cl_constructor with
-		| Some ctor when i = "new" -> build_type ctor,ctor
+		| Some ctor when i = "new" -> Some c, build_type ctor,ctor
 		| _ -> raise Not_found)
 	with Not_found -> try
 		match c.cl_super with
 		| None ->
 			raise Not_found
 		| Some (c,tl) ->
-			let t , f = raw_class_field build_type c i in
-			apply_params c.cl_types tl t , f
+			let c2 , t , f = raw_class_field build_type c i in
+			c2, apply_params c.cl_types tl t , f
 	with Not_found ->
 		match c.cl_kind with
 		| KTypeParameter tl ->
@@ -882,13 +882,13 @@ let rec raw_class_field build_type c i =
 					| TAnon a ->
 						(try
 							let f = PMap.find i a.a_fields in
-							build_type f, f
+							None, build_type f, f
 						with
 							Not_found -> loop ctl)
 					| TInst (c,pl) ->
 						(try
-							let t , f = raw_class_field build_type c i in
-							apply_params c.cl_types pl t, f
+							let c2, t , f = raw_class_field build_type c i in
+							c2, apply_params c.cl_types pl t, f
 						with
 							Not_found -> loop ctl)
 					| _ ->
@@ -906,8 +906,8 @@ let rec raw_class_field build_type c i =
 					raise Not_found
 				| (c,tl) :: l ->
 					try
-						let t , f = raw_class_field build_type c i in
-						apply_params c.cl_types tl t, f
+						let c2, t , f = raw_class_field build_type c i in
+						c2, apply_params c.cl_types tl t, f
 					with
 						Not_found -> loop l
 			in
@@ -918,8 +918,8 @@ let class_field = raw_class_field field_type
 let quick_field t n =
 	match follow t with
 	| TInst (c,_) ->
-		let _, f = raw_class_field (fun f -> f.cf_type) c n in
-		FInstance (c,f)
+		let c, _, f = raw_class_field (fun f -> f.cf_type) c n in
+		(match c with None -> FAnon f | Some c -> FInstance (c,f))
 	| TAnon a ->
 		(match !(a.a_status) with
 		| EnumStatics e ->
@@ -1028,7 +1028,7 @@ let rec unify a b =
 	| TInst (c,tl) , TAnon an ->
 		(try
 			PMap.iter (fun n f2 ->
-				let ft, f1 = (try class_field c n with Not_found -> error [has_no_field a n]) in
+				let _, ft, f1 = (try class_field c n with Not_found -> error [has_no_field a n]) in
 				if not (unify_kind f1.cf_kind f2.cf_kind) then error [invalid_kind n f1.cf_kind f2.cf_kind];
 				if f2.cf_public && not f1.cf_public then error [invalid_visibility n];
 				(try

+ 3 - 3
typeload.ml

@@ -562,7 +562,7 @@ let check_overriding ctx c =
 		PMap.iter (fun i f ->
 			let p = f.cf_pos in
 			try
-				let t , f2 = raw_class_field (fun f -> f.cf_type) csup i in
+				let _, t , f2 = raw_class_field (fun f -> f.cf_type) csup i in
 				(* allow to define fields that are not defined for this platform version in superclass *)
 				(match f2.cf_kind with
 				| Var { v_read = AccRequire _ } -> raise Not_found;
@@ -601,7 +601,7 @@ let class_field_no_interf c i =
 			raise Not_found
 		| Some (c,tl) ->
 			(* rec over class_field *)
-			let t , f = raw_class_field (fun f -> f.cf_type) c i in
+			let _, t , f = raw_class_field (fun f -> f.cf_type) c i in
 			apply_params c.cl_types tl t , f
 
 let rec check_interface ctx c intf params =
@@ -1291,7 +1291,7 @@ let init_class ctx c p context_init herits fields =
 			let check_method m t req_name =
 				if ctx.com.display then () else
 				try
-					let t2, f = (if stat then let f = PMap.find m c.cl_statics in f.cf_type, f else class_field c m) in
+					let _, t2, f = (if stat then let f = PMap.find m c.cl_statics in Some c, f.cf_type, f else class_field c m) in
 					unify_raise ctx t2 t f.cf_pos;
 					(match req_name with None -> () | Some n -> display_error ctx ("Please use " ^ n ^ " to name your property access method") f.cf_pos);
 				with

+ 9 - 9
typer.ml

@@ -541,7 +541,7 @@ let make_call ctx e params t p =
 	try
 		let ethis, fname = (match e.eexpr with TField (ethis,f) -> ethis, field_name f | _ -> raise Exit) in
 		let f, cl = (match follow ethis.etype with
-			| TInst (c,params) -> snd (try Type.class_field c fname with Not_found -> raise Exit), Some c
+			| TInst (c,params) -> (try let _,_,f = Type.class_field c fname in f with Not_found -> raise Exit), Some c
 			| TAnon a -> (try PMap.find fname a.a_fields with Not_found -> raise Exit), (match !(a.a_status) with Statics c -> Some c | _ -> None)
 			| _ -> raise Exit
 		) in
@@ -815,8 +815,8 @@ let rec type_ident_raise ?(imported_enums=true) ctx i p mode =
 	with Not_found -> try
 		(* member variable lookup *)
 		if ctx.curfun = FunStatic then raise Not_found;
-		let t , f = class_field ctx ctx.curclass [] i p in
-		field_access ctx mode f (FInstance (ctx.curclass,f)) t (get_this ctx p) p
+		let c , t , f = class_field ctx ctx.curclass [] i p in
+		field_access ctx mode f (match c with None -> FAnon f | Some c -> FInstance (c,f)) t (get_this ctx p) p
 	with Not_found -> try
 		(* lookup using on 'this' *)
 		if ctx.curfun = FunStatic then raise Not_found;
@@ -884,7 +884,7 @@ and type_field ctx e i p mode =
 				| Some (c,params) -> loop_dyn c params
 		in
 		(try
-			let t , f = class_field ctx c params i p in
+			let c2, t , f = class_field ctx c params i p in
 			if e.eexpr = TConst TSuper then (match mode,f.cf_kind with
 				| MGet,Var {v_read = AccCall _}
 				| MSet,Var {v_write = AccCall _}
@@ -895,11 +895,11 @@ and type_field ctx e i p mode =
 				| MCall, _ ->
 					()
 				| MGet,Var _
-				| MSet,Var _ when c.cl_extern && (match c.cl_path with "flash" :: _  , _ -> true | _ -> false) ->
+				| MSet,Var _ when (match c2 with Some { cl_extern = true; cl_path = ("flash" :: _,_) } -> true | _ -> false) ->
 					()
 				| _ -> error "Normal variables cannot be accessed with 'super', use 'this' instead" p);
 			if not (can_access ctx c f false) && not ctx.untyped then display_error ctx ("Cannot access private field " ^ i) p;
-			field_access ctx mode f (FInstance (c,f)) (apply_params c.cl_types params t) e p
+			field_access ctx mode f (match c2 with None -> FAnon f | Some c -> FInstance (c,f)) (apply_params c.cl_types params t) e p
 		with Not_found -> try
 			using_field ctx mode e i p
 		with Not_found -> try
@@ -1063,7 +1063,7 @@ let unify_int ctx e k =
 		| TAnon a ->
 			(try is_dynamic (PMap.find f a.a_fields).cf_type with Not_found -> false)
 		| TInst (c,pl) ->
-			(try is_dynamic (apply_params c.cl_types pl (fst (Type.class_field c f))) with Not_found -> false)
+			(try is_dynamic (apply_params c.cl_types pl ((let _,t,_ = Type.class_field c f in t))) with Not_found -> false)
 		| _ ->
 			true
 	in
@@ -2110,7 +2110,7 @@ and type_expr ctx (e,p) (with_type:with_type) =
 				(* can we inline hasNext() ? *)
 				(try
 					let c,pl = (match follow e1.etype with TInst (c,pl) -> c,pl | _ -> raise Exit) in
-					let ft, fhasnext = (try class_field ctx c pl "hasNext" p with Not_found -> raise Exit) in
+					let _, ft, fhasnext = (try class_field ctx c pl "hasNext" p with Not_found -> raise Exit) in
 					if fhasnext.cf_kind <> Method MethInline then raise Exit;
 					let tmp = gen_local ctx e1.etype in
 					let eit = mk (TLocal tmp) e1.etype p in
@@ -2674,7 +2674,7 @@ and check_to_string ctx t =
 	match follow t with
 	| TInst (c,_) ->
 		(try
-			let _, f = Type.class_field c "toString" in
+			let _, _, f = Type.class_field c "toString" in
 			ignore(follow f.cf_type);
 		with Not_found ->
 			())