[cpp] Check object implements interface when using TCast(a,b). For https://github.com/HaxeFoundation/hxcpp/issues/751

src/generators/gencpp.ml

@@ -2309,7 +2309,7 @@ let is_gc_element ctx member_type =
    | TCppWrapped _
    | TCppScalarArray _
    | TCppInst _
-   | TCppInterface _ 
+   | TCppInterface _
    | TCppClass
        -> true
    | _ -> false
@@ -3015,8 +3015,6 @@ let retype_expression ctx request_type function_args function_type expression_tr
             else (match return_type with
             | TCppNativePointer(klass) -> CppCastNative(baseCpp), return_type
             | TCppVoid -> baseCpp.cppexpr, TCppVoid
-            | TCppInterface _ ->
-                  baseCpp.cppexpr, return_type
             | TCppDynamic ->
                   baseCpp.cppexpr, baseCpp.cpptype
             | _ ->
@@ -3083,7 +3081,7 @@ let retype_expression ctx request_type function_args function_type expression_tr
             Using the 'typedef hack', where we use typedef X<T> = T, allows the
             haxe compiler to use these types interchangeably. We then work
             out the correct way to convert between them when one is expected, but another provided.
- 
+
             TCppFunction: these do not really interact with the haxe function type, T
             Since they are implemented with cpp::Function, conversion to/from Dynamic should happen automatically
                CallableData<T> = T;
@@ -3187,7 +3185,16 @@ let cpp_gen_default_values ctx args prefix =
    ) args;
 ;;
 
-let is_constant_zero expr =
+let ctx_default_values ctx args prefix =
+    cpp_gen_default_values ctx args prefix
+;;
+
+let cpp_class_hash interface =
+   gen_hash 0 (join_class_path interface.cl_path "::" )
+;;
+
+
+let rec is_constant_zero expr =
   match expr.cppexpr with
   | CppFloat x when (float_of_string x) = 0.0 -> true
   | CppInt i when i = Int32.of_int 0 -> true
@@ -3843,11 +3850,19 @@ let gen_cpp_ast_expression_tree ctx class_name func_name function_args function_
       | CppCode(value, exprs) ->
          Codegen.interpolate_code ctx.ctx_common (format_code value) exprs out (fun e -> gen e) expr.cpppos
       | CppTCast(expr,cppType) ->
-         let toType = tcpp_to_string cppType in
-         if toType="Dynamic" then
-            (out " ::Dynamic("; gen expr; out ")")
-         else
-            (out ("hx::TCast< " ^ toType ^ " >::cast("); gen expr; out ")")
+         (match cppType with
+         | TCppInterface(i) ->
+             out " hx::interface_check(";
+             gen expr;
+             out ("," ^ (cpp_class_hash i) ^")")
+         | _ -> begin
+            let toType = tcpp_to_string cppType in
+            if toType="Dynamic" then
+               (out " ::Dynamic("; gen expr; out ")")
+            else
+               (out ("hx::TCast< " ^ toType ^ " >::cast("); gen expr; out ")")
+            end
+         )
 
       | CppCastStatic(expr,toType) ->
          let close = match expr.cpptype with
@@ -4336,10 +4351,6 @@ let cpp_interface_impl_name ctx interface =
 ;;
 
 
-let cpp_class_hash interface =
-   gen_hash 0 (join_class_path interface.cl_path "::" )
-;;
-
 
 
 let has_field_init field =
@@ -4378,7 +4389,7 @@ let gen_member_def ctx class_def is_static is_interface field =
             let returnType = ctx_type_string ctx return_type in
             let returnStr = if returnType = "void" then "" else "return " in
             let commaArgList = if argList="" then argList else "," ^ argList in
-            let cast = "static_cast< ::" ^ join_class_path_remap class_def.cl_path "::" ^ "_obj *>" in
+            let cast = "hx::interface_cast< ::" ^ join_class_path_remap class_def.cl_path "::" ^ "_obj *>" in
             output ("		" ^ returnType ^ " (hx::Object :: *_hx_" ^ remap_name ^ ")(" ^ argList ^ "); \n");
             output ("		static inline " ^ returnType ^ " " ^ remap_name ^ "( ::Dynamic _hx_" ^ commaArgList ^ ") {\n");
             output ("			" ^ returnStr ^ "(_hx_.mPtr->*( " ^ cast ^ "(_hx_.mPtr->_hx_getInterface(" ^ (cpp_class_hash class_def) ^ ")))->_hx_" ^ remap_name ^ ")(" ^ cpp_arg_names args ^ ");\n		}\n" );
@@ -6140,7 +6151,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta
          List.iter dump_script_static class_def.cl_ordered_statics;
 
          output_cpp "static hx::ScriptNamedFunction __scriptableFunctions[] = {\n";
-         let dump_func f isStaticFlag = 
+         let dump_func f isStaticFlag =
             let s = try Hashtbl.find sigs f.cf_name with Not_found -> "v" in
             output_cpp ("  hx::ScriptNamedFunction(\"" ^ f.cf_name ^ "\",__s_" ^ f.cf_name ^ ",\"" ^ s ^ "\", " ^ isStaticFlag ^ " ),\n" )
          in
@@ -7594,13 +7605,13 @@ let generate_source ctx =
                let id = gen_hash32 seed class_name in
                (* reserve first 100 ids for runtime *)
                if id < Int32.of_int 100 || Hashtbl.mem existingIds id then
-                  makeId class_name (seed+100) 
+                  makeId class_name (seed+100)
                else begin
                   Hashtbl.add existingIds id true;
                   Hashtbl.add ctx.ctx_type_ids class_name id;
                end in
             makeId name 0;
- 
+
             build_xml := !build_xml ^ (get_class_code class_def Meta.BuildXml);
             if (has_init_field class_def) then
                init_classes := class_def.cl_path ::  !init_classes;