[cs] Fix wrongly detected ativeGeneric types

Previously types like Null<T> and some abstracts would make hxcs detect
that a class had to be `nativeGeneric`. This commit fixes that, and
also adds an actual error message instead of failing on the C#
compilation if a nativeGeneric class that implements a haxe generic
interface occurs

Closes #6533

src/codegen/gencommon/realTypeParams.ml

@@ -122,7 +122,21 @@ let rec is_hxgeneric md =
 		| TAbstract(a,_) -> not (Meta.has Meta.NativeGeneric a.a_meta)
 		| _ -> true
 
+type nativegeneric_reason =
+	| ReasonField of string * Type.t
+	| ReasonSuper of Globals.path
+	| ReasonExplicit
+
+exception Cannot_be_native of Globals.path * pos * Globals.path * nativegeneric_reason
+
 let rec set_hxgeneric gen mds isfirst md =
+	let iface_path, raise_pos, raise_if_native = match md with
+		| TClassDecl(cl) -> (try
+			(fst (List.find (fun (cl,_) -> (set_hxgeneric gen mds isfirst (TClassDecl cl) ) = Some(true) ) cl.cl_implements)).cl_path, cl.cl_pos, true
+		with Not_found ->
+			([],""), Globals.null_pos, false)
+		| _ -> ([],""), Globals.null_pos, false
+	in
 	let path = t_path md in
 	if List.exists (fun m -> path = t_path m) mds then begin
 		if isfirst then
@@ -137,14 +151,14 @@ let rec set_hxgeneric gen mds isfirst md =
 				| None -> has_unresolved := true; false
 				| Some true -> false
 		in
-
 		let mds = md :: mds in
 		match md with
 			| TClassDecl(cl)	->
 				(* first see if any meta is present (already processed) *)
-				if Meta.has Meta.NativeGeneric cl.cl_meta then
+				if Meta.has Meta.NativeGeneric cl.cl_meta then begin
+					if raise_if_native then raise (Cannot_be_native(path, raise_pos, iface_path, ReasonExplicit));
 					Some false
-				else if Meta.has Meta.HaxeGeneric cl.cl_meta then
+				end else if Meta.has Meta.HaxeGeneric cl.cl_meta then
 					Some true
 				else if cl.cl_params = [] && is_hxgen md then
 					(cl.cl_meta <- (Meta.HaxeGeneric,[],cl.cl_pos) :: cl.cl_meta;
@@ -163,6 +177,7 @@ let rec set_hxgeneric gen mds isfirst md =
 					(* on the first pass, our job is to find any evidence that makes it not be hxgeneric. Otherwise it will be hxgeneric *)
 					match cl.cl_super with
 						| Some (c,_) when is_false (set_hxgeneric gen mds isfirst (TClassDecl c)) ->
+							if raise_if_native then raise (Cannot_be_native(path, raise_pos, iface_path, ReasonSuper(c.cl_path)));
 							cl.cl_meta <- (Meta.NativeGeneric, [], cl.cl_pos) :: cl.cl_meta;
 							Some false
 						| _ ->
@@ -178,20 +193,25 @@ let rec set_hxgeneric gen mds isfirst md =
 								| _ ->
 									(* if it is, loop through all fields + statics and look for non-hxgeneric
 										generic classes that have KTypeParameter as params *)
-									let rec loop cfs =
+									let raise_or_return_true = if raise_if_native then
+											(fun cf -> raise (Cannot_be_native(path, raise_pos, iface_path, ReasonField(cf.cf_name, cf.cf_type))))
+										else
+											(fun cf -> true)
+									in
+									let rec cfs_must_be_native cfs =
 										match cfs with
 											| [] -> false
 											| cf :: cfs ->
 												let t = follow (gen.greal_type cf.cf_type) in
 												match t with
-													| TInst( { cl_kind = KTypeParameter _ }, _ ) -> loop cfs
+													| TInst( { cl_kind = KTypeParameter _ }, _ ) -> cfs_must_be_native cfs
 													| TInst(cl,p) when has_type_params t && is_false (set_hxgeneric gen mds isfirst (TClassDecl cl)) ->
-														if not (Hashtbl.mem gen.gtparam_cast cl.cl_path) then true else loop cfs
+														if not (Hashtbl.mem gen.gtparam_cast cl.cl_path) then raise_or_return_true cf else cfs_must_be_native cfs
 													| TEnum(e,p) when has_type_params t && is_false (set_hxgeneric gen mds isfirst (TEnumDecl e)) ->
-														if not (Hashtbl.mem gen.gtparam_cast e.e_path) then true else loop cfs
-													| _ -> loop cfs (* TAbstracts / Dynamics can't be generic *)
+														if not (Hashtbl.mem gen.gtparam_cast e.e_path) then raise_or_return_true cf else cfs_must_be_native cfs
+													| _ -> cfs_must_be_native cfs (* TAbstracts / Dynamics can't be generic *)
 									in
-									if loop cl.cl_ordered_fields then begin
+									if cfs_must_be_native cl.cl_ordered_fields then begin
 										cl.cl_meta <- (Meta.NativeGeneric, [], cl.cl_pos) :: cl.cl_meta;
 										Some false
 									end else if isfirst && !has_unresolved then
@@ -202,9 +222,10 @@ let rec set_hxgeneric gen mds isfirst md =
 									end
 				end
 			| TEnumDecl e ->
-				if Meta.has Meta.NativeGeneric e.e_meta then
+				if Meta.has Meta.NativeGeneric e.e_meta then begin
+					if raise_if_native then raise (Cannot_be_native(path, raise_pos, iface_path, ReasonExplicit));
 					Some false
-				else if Meta.has Meta.HaxeGeneric e.e_meta then
+				end else if Meta.has Meta.HaxeGeneric e.e_meta then
 					Some true
 				else if not (is_hxgen (TEnumDecl e)) then begin
 					e.e_meta <- (Meta.NativeGeneric, [], e.e_pos) :: e.e_meta;
@@ -216,7 +237,12 @@ let rec set_hxgeneric gen mds isfirst md =
 							e.e_meta <- (Meta.HaxeGeneric, [], e.e_pos) :: e.e_meta;
 							Some true
 						| _ ->
-							let rec loop efs =
+							let raise_or_return_true = if raise_if_native then
+									(fun name t -> raise (Cannot_be_native(path, raise_pos, iface_path, ReasonField(name, t))))
+								else
+									(fun _ _ -> true)
+							in
+							let rec efs_must_be_native efs =
 								match efs with
 									| [] -> false
 									| ef :: efs ->
@@ -229,18 +255,18 @@ let rec set_hxgeneric gen mds isfirst md =
 														| TInst( { cl_kind = KTypeParameter _ }, _ ) ->
 															false
 														| TInst(cl,p) when has_type_params t && is_false (set_hxgeneric gen mds isfirst (TClassDecl cl)) ->
-															not (Hashtbl.mem gen.gtparam_cast cl.cl_path)
+															if not (Hashtbl.mem gen.gtparam_cast cl.cl_path) then raise_or_return_true ef.ef_name t else false
 														| TEnum(e,p) when has_type_params t && is_false (set_hxgeneric gen mds isfirst (TEnumDecl e)) ->
-															not (Hashtbl.mem gen.gtparam_cast e.e_path)
+															if not (Hashtbl.mem gen.gtparam_cast e.e_path) then raise_or_return_true ef.ef_name t else false
 														| _ -> false
 												) args then
 													true
 												else
-													loop efs
-											| _ -> loop efs
+													efs_must_be_native efs
+											| _ -> efs_must_be_native efs
 							in
 							let efs = PMap.fold (fun ef acc -> ef :: acc) e.e_constrs [] in
-							if loop efs then begin
+							if efs_must_be_native efs then begin
 								e.e_meta <- (Meta.NativeGeneric, [], e.e_pos) :: e.e_meta;
 								Some false
 							end else if isfirst && !has_unresolved then
@@ -253,47 +279,66 @@ let rec set_hxgeneric gen mds isfirst md =
 			| _ -> assert false
 	end
 
+let path_s = function
+	| [],name -> name
+	| pack,name -> String.concat "." pack ^ "." ^ name
+
 let set_hxgeneric gen md =
-	let ret = match md with
-		| TClassDecl { cl_kind = KAbstractImpl a } -> (match follow_all_md md with
-			| (TInst _ | TEnum _ as t) -> (
-				let md = match t with
-					| TInst(cl,_) -> TClassDecl cl
-					| TEnum(e,_) -> TEnumDecl e
-					| _ -> assert false
+	try
+		let ret = match md with
+			| TClassDecl { cl_kind = KAbstractImpl a } -> (match follow_all_md md with
+				| (TInst _ | TEnum _ as t) -> (
+					let md = match t with
+						| TInst(cl,_) -> TClassDecl cl
+						| TEnum(e,_) -> TEnumDecl e
+						| _ -> assert false
+					in
+					let ret = set_hxgeneric gen [] true md in
+					if ret = None then get (set_hxgeneric gen [] false md) else get ret)
+				| TAbstract(a,_) -> true
+				| _ -> true)
+			| _ -> match set_hxgeneric gen [] true md with
+				| None ->
+					get (set_hxgeneric gen [] false md)
+				| Some v ->
+					v
+		in
+		if not ret then begin
+			match md with
+			| TClassDecl c ->
+				let set_hxgeneric (_,param) = match follow param with
+					| TInst(c,_) ->
+						c.cl_meta <- (Meta.NativeGeneric, [], c.cl_pos) :: c.cl_meta
+					| _ -> ()
 				in
-				let ret = set_hxgeneric gen [] true md in
-				if ret = None then get (set_hxgeneric gen [] false md) else get ret)
-			| TAbstract(a,_) -> true
-			| _ -> true)
-		| _ -> match set_hxgeneric gen [] true md with
-			| None ->
-				get (set_hxgeneric gen [] false md)
-			| Some v ->
-				v
-	in
-	if not ret then begin
-		match md with
-		| TClassDecl c ->
-			let set_hxgeneric (_,param) = match follow param with
-				| TInst(c,_) ->
-					c.cl_meta <- (Meta.NativeGeneric, [], c.cl_pos) :: c.cl_meta
-				| _ -> ()
-			in
-			List.iter set_hxgeneric c.cl_params;
-			let rec handle_field cf =
-				List.iter set_hxgeneric cf.cf_params;
-				List.iter handle_field cf.cf_overloads
-			in
-			(match c.cl_kind with
-				| KAbstractImpl a ->
-					List.iter set_hxgeneric a.a_params;
-				| _ -> ());
-			List.iter handle_field c.cl_ordered_fields;
-			List.iter handle_field c.cl_ordered_statics
-		| _ -> ()
-	end;
-	ret
+				List.iter set_hxgeneric c.cl_params;
+				let rec handle_field cf =
+					List.iter set_hxgeneric cf.cf_params;
+					List.iter handle_field cf.cf_overloads
+				in
+				(match c.cl_kind with
+					| KAbstractImpl a ->
+						List.iter set_hxgeneric a.a_params;
+					| _ -> ());
+				List.iter handle_field c.cl_ordered_fields;
+				List.iter handle_field c.cl_ordered_statics
+			| _ -> ()
+		end;
+		ret
+	with Cannot_be_native(path, pos, iface_path, reason) ->
+		let reason_start = "The class at path " ^ path_s path ^ " implements a haxe generic interface " ^ path_s iface_path
+			^ ". It however cannot be a haxe generic class "
+		in
+		let reason = reason_start ^ match reason with
+			| ReasonField (field_name, t) ->
+				"because its field " ^ field_name ^ " is of type " ^ debug_type t
+			| ReasonSuper (path) ->
+				"because it extends the type " ^ path_s path ^ " that was determined to be a native generic type"
+			| ReasonExplicit ->
+				"because it explicitly has the metadata @:nativeGeneric set"
+		in
+		gen.gcon.error (reason) pos;
+		assert false
 
 let params_has_tparams params =
 	List.fold_left (fun acc t -> acc || has_type_params t) false params
@@ -460,12 +505,16 @@ struct
 				| _ -> assert false
 			in
 			List.map (fun (cf, t_cl, t_cf) ->
+				let t_cf = follow (gen.greal_type t_cf) in
 				let this_field = mk (TField (this, FInstance (cl, List.map snd cl.cl_params, cf))) t_cl pos in
 				let expr =
 					binop
 						OpAssign
 						(mk (TField (local_new_me, FInstance(cl, List.map snd cl.cl_params, cf))) t_cf pos)
-						(try (Hashtbl.find gen.gtparam_cast (get_path t_cf)) this_field t_cf with Not_found -> (* if not found tparam cast, it shouldn't be a valid hxgeneric *) assert false)
+						(try (Hashtbl.find gen.gtparam_cast (get_path t_cf)) this_field t_cf with Not_found ->
+							(* if not found tparam cast, it shouldn't be a valid hxgeneric *)
+							print_endline ("Could not find a gtparam_cast for " ^ (String.concat "." (fst (get_path t_cf)) ^ "." ^ (snd (get_path t_cf))));
+							assert false)
 						t_cf
 						pos
 				in

src/generators/gencs.ml

@@ -599,7 +599,8 @@ let add_cast_handler gen =
 		}
 	in
 
-	Hashtbl.add gen.gtparam_cast (["cs"], "NativeArray") gtparam_cast_native_array
+	Hashtbl.add gen.gtparam_cast (["cs"], "NativeArray") gtparam_cast_native_array;
+	Hashtbl.add gen.gtparam_cast (["haxe";"lang"], "Null") (fun e to_t -> mk_cast to_t e)
 	(* end set gtparam_cast *)
 
 let connecting_string = "?" (* ? see list here http://www.fileformat.info/info/unicode/category/index.htm and here for C# http://msdn.microsoft.com/en-us/library/aa664670.aspx *)

tests/unit/src/unit/issues/Issue6533.hx

@@ -0,0 +1,33 @@
+package unit.issues;
+
+private interface InterfaceA<T> { }
+
+private abstract AbstractC<T>(ClassC<T>) {
+    public function new() this = new ClassC();
+}
+
+private class ClassC<T> implements InterfaceA<T> {
+
+    public var foo(get, never):Null<T>;
+    function get_foo():Null<T> return null;
+
+    public function new() { }
+}
+
+private interface EmptyGenericInterface<T> {
+}
+
+private class ClassWithNullableField<T> implements EmptyGenericInterface<T> {
+	public var nullableField:Null<T>;
+
+	public function new() {
+	}
+}
+
+class Issue6533 extends Test {
+    public function test():Void {
+        var example:ClassWithNullableField<Int> = new ClassWithNullableField<Int>();
+        example.nullableField = 42;
+        var c = new AbstractC();
+    }
+}