Browse Source

[typer] add some stacks to deal with abstract recursion

closes #4891
Simon Krajewski 7 years ago
parent
commit
40e9a8b053

+ 33 - 27
src/context/abstractCast.ml

@@ -46,35 +46,41 @@ let do_check_cast ctx tleft eright p =
 	if type_iseq tleft eright.etype then
 		eright
 	else begin
-		let rec loop tleft tright = match follow tleft,follow tright with
-		| TAbstract(a1,tl1),TAbstract(a2,tl2) ->
-			Abstract.find_to_from find a1 tl1 a2 tl2 tleft eright.etype
-		| TAbstract(a,tl),_ ->
-			begin try find a tl (fun () -> Abstract.find_from a tl eright.etype tleft)
-			with Not_found ->
-				let rec loop2 tcl = match tcl with
-					| tc :: tcl ->
-						if not (type_iseq tc tleft) then loop (apply_params a.a_params tl tc) tright
-						else loop2 tcl
-					| [] -> raise Not_found
-				in
-				loop2 a.a_from
-			end
-		| _,TAbstract(a,tl) ->
-			begin try find a tl (fun () -> Abstract.find_to a tl tleft)
-			with Not_found ->
-				let rec loop2 tcl = match tcl with
-					| tc :: tcl ->
-						if not (type_iseq tc tright) then loop tleft (apply_params a.a_params tl tc)
-						else loop2 tcl
-					| [] -> raise Not_found
-				in
-				loop2 a.a_to
+		let rec loop stack tleft tright =
+			if List.exists (fun (tleft',tright') -> fast_eq tleft tleft' && fast_eq tright tright') stack then
+				raise Not_found
+			else begin
+				let stack = (tleft,tright) :: stack in
+				match follow tleft,follow tright with
+				| TAbstract(a1,tl1),TAbstract(a2,tl2) ->
+					Abstract.find_to_from find a1 tl1 a2 tl2 tleft eright.etype
+				| TAbstract(a,tl),_ ->
+					begin try find a tl (fun () -> Abstract.find_from a tl eright.etype tleft)
+					with Not_found ->
+						let rec loop2 tcl = match tcl with
+							| tc :: tcl ->
+								if not (type_iseq tc tleft) then loop stack (apply_params a.a_params tl tc) tright
+								else loop2 tcl
+							| [] -> raise Not_found
+						in
+						loop2 a.a_from
+					end
+				| _,TAbstract(a,tl) ->
+					begin try find a tl (fun () -> Abstract.find_to a tl tleft)
+					with Not_found ->
+						let rec loop2 tcl = match tcl with
+							| tc :: tcl ->
+								if not (type_iseq tc tright) then loop stack tleft (apply_params a.a_params tl tc)
+								else loop2 tcl
+							| [] -> raise Not_found
+						in
+						loop2 a.a_to
+					end
+				| _ ->
+					raise Not_found
 			end
-		| _ ->
-			raise Not_found
 		in
-		loop tleft eright.etype
+		loop [] tleft eright.etype
 	end
 
 let cast_or_unify_raise ctx tleft eright p =

+ 4 - 4
src/typing/typer.ml

@@ -1627,11 +1627,11 @@ and type_object_decl ctx fl with_type p =
 	let dynamic_parameter = ref None in
 	let a = (match with_type with
 	| WithType t ->
-		let rec loop t =
+		let rec loop seen t =
 			match follow t with
 			| TAnon a -> ODKWithStructure a
-			| TAbstract (a,pl) when not (Meta.has Meta.CoreType a.a_meta) ->
-				(match List.fold_left (fun acc t -> match loop t with ODKPlain -> acc | t -> t :: acc) [] (get_abstract_froms a pl) with
+			| TAbstract (a,pl) as t when not (Meta.has Meta.CoreType a.a_meta) && not (List.exists (fun t' -> fast_eq t t') seen) ->
+				(match List.fold_left (fun acc t' -> match loop (t :: seen) t' with ODKPlain -> acc | t -> t :: acc) [] (get_abstract_froms a pl) with
 				| [t] -> t
 				| _ -> ODKPlain)
 			| TDynamic t when (follow t != t_dynamic) ->
@@ -1645,7 +1645,7 @@ and type_object_decl ctx fl with_type p =
 			| _ ->
 				ODKPlain
 		in
-		loop t
+		loop [] t
 	| _ ->
 		ODKPlain
 	) in

+ 8 - 0
tests/misc/projects/Issue4891/Main.hx

@@ -0,0 +1,8 @@
+abstract Ab1(Ab2) from Ab2 {}
+abstract Ab2(Ab1) from Ab1 {}
+
+class Main {
+    static function main() {
+        var a:Ab1 = {};
+    }
+}

+ 2 - 0
tests/misc/projects/Issue4891/compile-fail.hxml

@@ -0,0 +1,2 @@
+-main Main
+--interp

+ 1 - 0
tests/misc/projects/Issue4891/compile-fail.hxml.stderr

@@ -0,0 +1 @@
+Main.hx:6: characters 9-24 : { } should be Ab1