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

added again generic recursion check vs. type parameter usage (fixed issue #1169)

Simon Krajewski пре 13 година
родитељ
комит
288914481e
2 измењених фајлова са 14 додато и 3 уклоњено
  1. 13 3
      codegen.ml
  2. 1 0
      typer.ml

+ 13 - 3
codegen.ml

@@ -222,9 +222,10 @@ let rec build_generic ctx c p tl =
 		| [] , name -> name
 		| l , name -> String.concat "_" l ^ "_" ^ name
 	) tl)) in
-	if !recurse then
+	if !recurse then begin
+		if not (has_meta ":?genericRec" c.cl_meta) then c.cl_meta <- (":?genericRec",[],p) :: c.cl_meta;
 		TInst (c,tl) (* build a normal instance *)
-	else try
+	end else try
 		Typeload.load_instance ctx { tpackage = pack; tname = name; tparams = []; tsub = None } p false
 	with Error(Module_not_found path,_) when path = (pack,name) ->
 		let m = (try Hashtbl.find ctx.g.modules (Hashtbl.find ctx.g.types_module c.cl_path) with Not_found -> assert false) in
@@ -534,7 +535,16 @@ let check_private_path ctx t = match t with
 (* Removes generic base classes *)
 let remove_generic_base ctx t = match t with
 	| TClassDecl c when c.cl_kind = KGeneric ->
-		c.cl_extern <- true;
+		(try
+			let (_,_,prec) = get_meta ":?genericRec" c.cl_meta in
+			(try
+				let (_,_,pnew) = get_meta ":?genericT" c.cl_meta in			
+				display_error ctx ("Class " ^ (s_type_path c.cl_path) ^ " was used recursively and cannot use its type parameter") prec;
+				error "Type parameter usage was here" pnew
+			with Not_found _ ->
+				());
+		with Not_found ->
+			c.cl_extern <- true);
 	| _ ->
 		()
 

+ 1 - 0
typer.ml

@@ -1958,6 +1958,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 		let el, c , params = (match follow t with
 		| TInst ({cl_kind = KTypeParameter tl} as c,params) ->
 			if not (ctx.curclass.cl_kind = KGeneric) then display_error ctx "Type parameters can only be constructed in generic instances" p;
+			if not (has_meta ":?genericT" ctx.curclass.cl_meta) then ctx.curclass.cl_meta <- (":?genericT",[],p) :: ctx.curclass.cl_meta;
 			(try
 				let tt = List.assoc (snd c.cl_path) ctx.curclass.cl_types in
 				if not (type_iseq tt t) then raise Not_found;