Procházet zdrojové kódy

fix matching on parent class fields again (see #3507)

Simon Krajewski před 9 roky
rodič
revize
400bf3713d

+ 20 - 12
src/typing/matcher.ml

@@ -343,24 +343,32 @@ module Pattern = struct
 						fail()
 				end
 			| EObjectDecl fl ->
-				let known_fields,map = match follow t with
+				let known_fields = match follow t with
 					| TAnon an ->
-						an.a_fields,(fun t -> t)
-					| TInst(c,tl) -> c.cl_fields,apply_params c.cl_params tl
+						PMap.fold (fun cf acc -> (cf,cf.cf_type) :: acc) an.a_fields []
+					| TInst(c,tl) ->
+						let rec loop fields c tl =
+							let fields = List.fold_left (fun acc cf -> (cf,apply_params c.cl_params tl cf.cf_type) :: acc) fields c.cl_ordered_fields in
+							match c.cl_super with
+								| None -> fields
+								| Some (csup,tlsup) -> loop fields csup (List.map (apply_params c.cl_params tl) tlsup)
+						in
+						loop [] c tl
 					| TAbstract({a_impl = Some c} as a,tl) ->
 						let fields = List.fold_left (fun acc cf ->
 							if Meta.has Meta.Impl cf.cf_meta then
-								PMap.add cf.cf_name cf acc
-							else acc
-						) PMap.empty c.cl_ordered_statics in
-						fields,apply_params a.a_params tl
-					| _ -> error (Printf.sprintf "Cannot field-match against %s" (s_type t)) (pos e)
+								(cf,apply_params a.a_params tl cf.cf_type) :: acc
+							else
+								acc
+						) [] c.cl_ordered_statics in
+						fields
+					| _ ->
+						error (Printf.sprintf "Cannot field-match against %s" (s_type t)) (pos e)
 				in
 				let is_matchable cf =
 					match cf.cf_kind with Method _ -> false | _ -> true
 				in
-				let patterns,fields = PMap.fold (fun cf (patterns,fields) ->
-					let t = map cf.cf_type in
+				let patterns,fields = List.fold_left (fun (patterns,fields) (cf,t) ->
 					try
 						if pctx.in_reification && cf.cf_name = "pos" then raise Not_found;
 						let e1 = List.assoc cf.cf_name fl in
@@ -370,8 +378,8 @@ module Pattern = struct
 							(PatAny,cf.cf_pos) :: patterns,cf.cf_name :: fields
 						else
 							patterns,fields
-				) known_fields ([],[]) in
-				(* List.iter (fun (s,e) -> if not (List.mem s fields) then error (Printf.sprintf "%s has no field %s" (s_type t) s) (pos e)) fl; *)
+				) ([],[]) known_fields in
+				List.iter (fun (s,e) -> if not (List.mem s fields) then error (Printf.sprintf "%s has no field %s" (s_type t) s) (pos e)) fl;
 				PatConstructor(ConFields fields,patterns)
 			| EBinop(OpOr,e1,e2) ->
 				let pctx1 = {pctx with current_locals = PMap.empty} in

+ 11 - 2
tests/unit/src/unit/issues/Issue3507.hx

@@ -26,10 +26,19 @@ private class C<T1, T2, T3> extends B<T1, T2> {
 class Issue3507 extends Test {
 	function test() {
 		var c = new C("foo", 12, false);
-		var s = switch (c) {
+		var c2 = new C("foo", 12, true);
+		var c3 = new C("foo", 13, false);
+		var c4 = new C("bar", 12, false);
+		eq("ok", match(c));
+		eq("not ok", match(c2));
+		eq("not ok", match(c3));
+		eq("not ok", match(c4));
+	}
+
+	function match(c:C<String, Int, Bool>) {
+		return switch (c) {
 			case { t1:'foo', t2:12, t3:false } : "ok";
 			case _: "not ok";
 		}
-		eq("ok", s);
 	}
 }

+ 1 - 1
tests/unit/unit.hxproj

@@ -62,7 +62,7 @@
     <hidden path="obj" />
   </hiddenPaths>
   <!-- Executed before build -->
-  <preBuildCommand>"$(CompilerPath)/haxe" compile$(TargetBuild).hxml</preBuildCommand>
+  <preBuildCommand>"$(CompilerPath)/haxe.exe" compile$(TargetBuild).hxml</preBuildCommand>
   <!-- Executed after build -->
   <postBuildCommand alwaysRun="False" />
   <!-- Other project options -->