Selaa lähdekoodia

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

Nicolas Cannasse 12 vuotta sitten
vanhempi
commit
18d0123ac9
3 muutettua tiedostoa jossa 24 lisäystä ja 24 poistoa
  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 ->
 			())