فهرست منبع

disallow extending non-generic type parameters

Simon Krajewski 12 سال پیش
والد
کامیت
125553b104
3فایلهای تغییر یافته به همراه16 افزوده شده و 14 حذف شده
  1. 1 12
      codegen.ml
  2. 14 1
      typeload.ml
  3. 1 1
      typer.ml

+ 1 - 12
codegen.ml

@@ -271,17 +271,6 @@ let generic_substitute_expr gctx e =
 	in
 	in
 	build_expr e
 	build_expr e
 
 
-let is_generic_parameter ctx c =
-	(* first check field parameters, then class parameters *)
-	try
-		ignore (List.assoc (snd c.cl_path) ctx.curfield.cf_params);
-		Meta.has Meta.Generic ctx.curfield.cf_meta
-	with Not_found -> try
-		ignore(List.assoc (snd c.cl_path) ctx.type_params);
-		(match ctx.curclass.cl_kind with | KGeneric -> true | _ -> false);
-	with Not_found ->
-		false
-
 let has_ctor_constraint c = match c.cl_kind with
 let has_ctor_constraint c = match c.cl_kind with
 	| KTypeParameter tl ->
 	| KTypeParameter tl ->
 		List.exists (fun t -> match follow t with
 		List.exists (fun t -> match follow t with
@@ -298,7 +287,7 @@ let rec build_generic ctx c p tl =
 		| TInst (c2,tl) ->
 		| TInst (c2,tl) ->
 			(match c2.cl_kind with
 			(match c2.cl_kind with
 			| KTypeParameter tl ->
 			| KTypeParameter tl ->
-				if not (is_generic_parameter ctx c2) && has_ctor_constraint c2 then
+				if not (Typeload.is_generic_parameter ctx c2) && has_ctor_constraint c2 then
 					error "Type parameters with a constructor cannot be used non-generically" p;
 					error "Type parameters with a constructor cannot be used non-generically" p;
 				recurse := true
 				recurse := true
 			| _ -> ());
 			| _ -> ());

+ 14 - 1
typeload.ml

@@ -912,6 +912,17 @@ let rec return_flow ctx e =
 (* ---------------------------------------------------------------------- *)
 (* ---------------------------------------------------------------------- *)
 (* PASS 1 & 2 : Module and Class Structure *)
 (* PASS 1 & 2 : Module and Class Structure *)
 
 
+let is_generic_parameter ctx c =
+	(* first check field parameters, then class parameters *)
+	try
+		ignore (List.assoc (snd c.cl_path) ctx.curfield.cf_params);
+		Meta.has Meta.Generic ctx.curfield.cf_meta
+	with Not_found -> try
+		ignore(List.assoc (snd c.cl_path) ctx.type_params);
+		(match ctx.curclass.cl_kind with | KGeneric -> true | _ -> false);
+	with Not_found ->
+		false
+
 let set_heritance ctx c herits p =
 let set_heritance ctx c herits p =
 	let ctx = { ctx with curclass = c; type_params = c.cl_types; } in
 	let ctx = { ctx with curclass = c; type_params = c.cl_types; } in
 	let process_meta csup =
 	let process_meta csup =
@@ -945,7 +956,9 @@ let set_heritance ctx c herits p =
 					c.cl_implements <- (csup,params) :: c.cl_implements
 					c.cl_implements <- (csup,params) :: c.cl_implements
 				end else begin
 				end else begin
 					if csup.cl_interface then error "Cannot extend by using an interface" p;
 					if csup.cl_interface then error "Cannot extend by using an interface" p;
-					c.cl_super <- Some (csup,params)
+					match csup.cl_kind with
+					| KTypeParameter _ when not (is_generic_parameter ctx csup) -> error "Cannot extend non-generic type parameters" p
+					| _ -> c.cl_super <- Some (csup,params)
 				end
 				end
 			| _ -> error "Should extend by using a class" p)
 			| _ -> error "Should extend by using a class" p)
 		| HImplements t ->
 		| HImplements t ->

+ 1 - 1
typer.ml

@@ -2658,7 +2658,7 @@ and type_expr ctx (e,p) (with_type:with_type) =
 		) in
 		) in
 		(match follow ct with
 		(match follow ct with
 		| TInst ({cl_kind = KTypeParameter tl} as c,params) ->
 		| TInst ({cl_kind = KTypeParameter tl} as c,params) ->
-			if not (Codegen.is_generic_parameter ctx c) then error "Only generic type parameters can be constructed" p;
+			if not (Typeload.is_generic_parameter ctx c) then error "Only generic type parameters can be constructed" p;
 			let el = List.map (fun e -> type_expr ctx e Value) el in
 			let el = List.map (fun e -> type_expr ctx e Value) el in
 			let ct = (tfun (List.map (fun e -> e.etype) el) ctx.t.tvoid) in
 			let ct = (tfun (List.map (fun e -> e.etype) el) ctx.t.tvoid) in
 			if not (List.exists (fun t -> match follow t with
 			if not (List.exists (fun t -> match follow t with