Jelajahi Sumber

fixed subtyping with getter/setter.

Nicolas Cannasse 19 tahun lalu
induk
melakukan
4a9f7fc4d6
2 mengubah file dengan 14 tambahan dan 3 penghapusan
  1. 11 2
      type.ml
  2. 3 1
      typer.ml

+ 11 - 2
type.ml

@@ -323,7 +323,8 @@ let rec type_eq param a b =
 		let keys2 = PMap.fold (fun f acc -> f :: acc) fl2 [] in
 		(try
 			List.iter2 (fun f1 f2 ->
-				if f1.cf_name <> f2.cf_name || not (type_eq param f1.cf_type f2.cf_type) then raise Not_found
+				if f1.cf_name <> f2.cf_name || not (type_eq param f1.cf_type f2.cf_type) then raise Not_found;
+				if f1.cf_get <> f2.cf_get || f1.cf_set <> f2.cf_set then raise Not_found;
 			) keys1 keys2;
 			true
 		with
@@ -340,11 +341,13 @@ type unify_error =
 	| Cannot_unify of t * t
 	| Invalid_field_type of string
 	| Has_no_field of t * string
+	| Invalid_access of string * bool
 
 exception Unify_error of unify_error list
 
 let cannot_unify a b = Cannot_unify (a,b)
 let invalid_field n = Invalid_field_type n
+let invalid_access n get = Invalid_access (n,get)
 let has_no_field t n = Has_no_field (t,n)
 let error l = raise (Unify_error l)
 
@@ -394,6 +397,8 @@ let rec unify a b =
 		(try
 			PMap.iter (fun n f2 ->
 				let f1 = (try PMap.find n c.cl_fields with Not_found -> error [has_no_field a n]) in
+				if f1.cf_get <> f2.cf_get then error [invalid_access n true];
+				if f1.cf_set <> f2.cf_set then error [invalid_access n false];
 				try 
 					unify (apply_params c.cl_types tl f1.cf_type) f2.cf_type
 				with
@@ -405,6 +410,8 @@ let rec unify a b =
 		let rec loop c tl =
 			PMap.iter (fun n f2 ->
 				let f1 = (try PMap.find n fl with Not_found -> error [has_no_field a n]) in
+				if f1.cf_get <> f2.cf_get then error [invalid_access n true];
+				if f1.cf_set <> f2.cf_set then error [invalid_access n false];
 				try
 					unify f1.cf_type (apply_params c.cl_types tl f2.cf_type)
 				with
@@ -424,8 +431,10 @@ let rec unify a b =
 		(try
 			PMap.iter (fun n f2 ->
 				let f1 = (try PMap.find n fl1 with Not_found -> error [has_no_field a n]) in
+				if f1.cf_get <> f2.cf_get then error [invalid_access n true];
+				if f1.cf_set <> f2.cf_set then error [invalid_access n false];
 				try
-					unify f1.cf_type f2.cf_type
+					unify f1.cf_type f2.cf_type;
 				with
 					Unify_error l -> error (invalid_field n :: l)
 			) fl2;			

+ 3 - 1
typer.ml

@@ -75,6 +75,8 @@ let unify_error_msg ctx = function
 		"Invalid type for field " ^ s ^ " :"
 	| Has_no_field (t,n) ->
 		s_type ctx t ^ " has no field " ^ n
+	| Invalid_access (f,get) ->
+		"Inconsistent " ^ (if get then "getter" else "setter") ^ " for field " ^ f
 
 let rec error_msg = function
 	| Module_not_found m -> "Class not found : " ^ s_type_path m
@@ -1418,7 +1420,7 @@ let check_interfaces c p () =
 		PMap.iter (fun i f ->
 			try
 				let t , f2 = class_field c i in
-				if f2.cf_public <> f.cf_public then error ("Field " ^ i ^ " has different access than in " ^ s_type_path intf.cl_path) p;
+				if f2.cf_public <> f.cf_public || f2.cf_get <> f.cf_get || f2.cf_set <> f.cf_set then error ("Field " ^ i ^ " has different access than in " ^ s_type_path intf.cl_path) p;
 				if not (type_eq false f2.cf_type (apply_params intf.cl_types params f.cf_type)) then error ("Field " ^ i ^ " has different type than in " ^ s_type_path intf.cl_path) p;
 			with
 				Not_found ->