Browse Source

[hl] fix stack overflow on recursive abstract (closes #8243)

Aleksandr Kuzmenko 6 years ago
parent
commit
c6ede59cad
2 changed files with 20 additions and 15 deletions
  1. 20 12
      src/generators/genhl.ml
  2. 0 3
      tests/unit/src/unit/issues/Issue8243.hx

+ 20 - 12
src/generators/genhl.ml

@@ -352,6 +352,18 @@ let fake_tnull =
 		a_params = ["T",t_dynamic];
 	}
 
+let get_rec_cache ctx t none_callback not_found_callback =
+	try
+		match !(List.assq t ctx.rec_cache) with
+		| None -> none_callback()
+		| Some t -> t
+	with Not_found ->
+		let tref = ref None in
+		ctx.rec_cache <- (t,tref) :: ctx.rec_cache;
+		let t = not_found_callback tref in
+		ctx.rec_cache <- List.tl ctx.rec_cache;
+		t
+
 let rec to_type ?tref ctx t =
 	match t with
 	| TMono r ->
@@ -359,17 +371,11 @@ let rec to_type ?tref ctx t =
 		| None -> HDyn
 		| Some t -> to_type ?tref ctx t)
 	| TType (td,tl) ->
-		let t = (try
-			match !(List.assq t ctx.rec_cache) with
-			| None -> abort "Unsupported recursive type" td.t_pos
-			| Some t -> t
-		with Not_found ->
-			let tref = ref None in
-			ctx.rec_cache <- (t,tref) :: ctx.rec_cache;
-			let t = to_type ~tref ctx (apply_params td.t_params tl td.t_type) in
-			ctx.rec_cache <- List.tl ctx.rec_cache;
-			t
-		) in
+		let t =
+			get_rec_cache ctx t
+				(fun() -> abort "Unsupported recursive type" td.t_pos)
+				(fun tref -> to_type ~tref ctx (apply_params td.t_params tl td.t_type))
+		in
 		(match td.t_path with
 		| ["haxe";"macro"], name -> Hashtbl.replace ctx.macro_typedefs name t; t
 		| _ -> t)
@@ -454,7 +460,9 @@ let rec to_type ?tref ctx t =
 			| ["haxe";"macro"], "Position" -> HAbstract ("macro_pos", alloc_string ctx "macro_pos")
 			| _ -> failwith ("Unknown core type " ^ s_type_path a.a_path))
 		else
-			to_type ?tref ctx (Abstract.get_underlying_type a pl)
+			get_rec_cache ctx t
+				(fun() -> HDyn)
+				(fun tref -> to_type ~tref ctx (Abstract.get_underlying_type a pl))
 
 and resolve_class ctx c pl statics =
 	let not_supported() =

+ 0 - 3
tests/unit/src/unit/issues/Issue8243.hx

@@ -1,14 +1,11 @@
 package unit.issues;
 
 class Issue8243 extends unit.Test {
-#if !hl // TODO https://github.com/HaxeFoundation/haxe/issues/8243
-
 	var involveRecursiveAbstractTyping:Null<Rec> = null;
 
 	function test() {
 		t(involveRecursiveAbstractTyping == null);
 	}
-#end
 }
 
 private abstract Rec(Array<Rec>) from Array<Rec> {}