Преглед изворни кода

add some stack overflow detection (see #1757)

Simon Krajewski пре 11 година
родитељ
комит
7467eea237
2 измењених фајлова са 13 додато и 3 уклоњено
  1. 6 2
      codegen.ml
  2. 7 1
      type.ml

+ 6 - 2
codegen.ml

@@ -668,7 +668,9 @@ module AbstractCast = struct
 				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 -> loop (apply_params a.a_params tl tc) tright
+						| 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
@@ -677,7 +679,9 @@ module AbstractCast = struct
 				begin try find a tl (fun () -> Abstract.find_to a tl tleft)
 				with Not_found ->
 					let rec loop2 tcl = match tcl with
-						| tc :: tcl -> loop tleft (apply_params a.a_params tl tc)
+						| 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

+ 7 - 1
type.ml

@@ -1477,13 +1477,19 @@ and unify_anons a b a1 a2 =
 		Unify_error l -> error (cannot_unify a b :: l))
 
 and unify_from ab tl a b ?(allow_transitive_cast=true) t =
+	if (List.exists (fun (a2,b2) -> fast_eq a a2 && fast_eq b b2) (!abstract_cast_stack)) then false else begin
+	abstract_cast_stack := (a,b) :: !abstract_cast_stack;
 	let t = apply_params ab.a_params tl t in
 	let unify_func = if allow_transitive_cast then unify else type_eq EqStrict in
-	try
+	let b = try
 		unify_func a t;
 		true
 	with Unify_error _ ->
 		false
+	in
+	abstract_cast_stack := List.tl !abstract_cast_stack;
+	b
+	end
 
 and unify_to ab tl b ?(allow_transitive_cast=true) t =
 	let t = apply_params ab.a_params tl t in