[objc] Add initial boxing tests, and guard changes on `-D objc` define

The tests contained herein will only pass once HaxeFoundation/hxcpp#245
is accepted. It adds basic tests for the boxing and unboxing operations,
and it adds some extra code to handle `null`, and a few operators
correctly.

Also, this makes sure that `@:objc` code is only run when `-D objc` is
defined - which should make any changes safe against regressions. I've
also made sure any added code is labeled `objc` properly.

common.ml

@@ -223,6 +223,7 @@ module Define = struct
 		| NoSimplify
 		| NoSwfCompress
 		| NoTraces
+		| Objc
 		| PhpPrefix
 		| RealPosition
 		| ReplaceFiles
@@ -307,6 +308,7 @@ module Define = struct
 		| NoSimplify -> "no_simplify",("Disable simplification filter")
 		| NoSwfCompress -> ("no_swf_compress","Disable SWF output compression")
 		| NoTraces -> ("no_traces","Disable all trace calls")
+		| Objc -> ("objc","Sets the hxcpp output to objective-c++ classes. Must be defined for interop")
 		| PhpPrefix -> ("php_prefix","Compiled with --php-prefix")
 		| RealPosition -> ("real_position","Disables haxe source mapping when targetting C#")
 		| ReplaceFiles -> ("replace_files","GenCommon internal")

gencpp.ml

@@ -171,8 +171,11 @@ let new_source_file common_ctx base_dir sub_dir extension class_path =
 
 
 let source_file_extension common_ctx =
-   try
-     "." ^ (Common.defined_value common_ctx Define.FileExtension)
+   (* no need to -D file_extension if -D objc is defined *)
+   if Common.defined common_ctx Define.Objc then
+      ".mm"
+   else try
+      "." ^ (Common.defined_value common_ctx Define.FileExtension)
    with
      Not_found -> ".cpp"
 ;;
@@ -569,6 +572,11 @@ let is_objc_call field =
   | _ -> false
 ;;
 
+let is_objc_type t = match follow t with
+  | TInst(cl,_) -> cl.cl_extern && Meta.has Meta.Objc cl.cl_meta
+  | _ -> false
+;;
+
 let is_addressOf_call func =
    match (remove_parens func).eexpr with
    | TField (_,FStatic ({cl_path=["cpp"],"Pointer"},{cf_name="addressOf"} ) ) -> true
@@ -653,7 +661,7 @@ let rec class_string klass suffix params remap =
             | _ -> "/*NULL*/" ^ (type_string t) )
          | _ -> assert false);
    (* Objective-C class *)
-   | path when klass.cl_extern && Meta.has Meta.Objc klass.cl_meta ->
+   | path when is_objc_type (TInst(klass,[])) ->
      let str = join_class_path_remap klass.cl_path "::" in
      if suffix = "_obj" then
        str
@@ -1815,6 +1823,20 @@ and gen_expression ctx retval expression =
          gen_expression_list remaining
       ) in
 
+   (* this will add a cast if boxing / unboxing an objective-c type *)
+   let check_objc_unbox expression to_type =
+     if is_objc_type to_type && not (is_objc_type expression.etype) then
+        { expression with eexpr = TCast(expression,None); etype = to_type }
+     else
+        expression
+   in
+   let check_objc_box expression to_type =
+     if is_objc_type expression.etype && not (is_objc_type to_type) then
+        { expression with eexpr = TCast(expression,None); etype = to_type }
+     else
+        expression
+   in
+
    let rec gen_bin_op_string expr1 op expr2 =
       let cast = (match op with
          | ">>" | "<<" | "&" | "|" | "^"  -> "int("
@@ -1846,6 +1868,11 @@ and gen_expression ctx retval expression =
       | _ -> ""
    in
    let rec gen_bin_op op expr1 expr2 =
+      let expr1, expr2 = match op with
+         | Ast.OpAssign | Ast.OpAssignOp _ -> expr1, check_objc_unbox expr2 expr1.etype
+         | Ast.OpEq | Ast.OpNotEq -> check_objc_box expr1 expr2.etype, check_objc_box expr2 expr1.etype
+         | _ -> expr1,expr2
+      in
       match op with
       | Ast.OpAdd when (is_const_string_term expr1) && (is_const_string_term expr2) ->
          output (str ((combine_string_terms expr1) ^ (combine_string_terms expr2)) )
@@ -2210,6 +2237,7 @@ and gen_expression ctx retval expression =
       | TString s -> output (str s)
       | TBool b -> output (if b then "true" else "false")
       (*| TNull -> output ("((" ^ (type_string expression.etype) ^ ")null())")*)
+      | TNull when is_objc_type expression.etype -> output "nil"
       | TNull -> output (if ctx.ctx_for_extern then "null" else "null()")
       | TThis -> output (if ctx.ctx_real_this_ptr then "hx::ObjectPtr<OBJ_>(this)" else "__this")
       | TSuper when calling ->
@@ -2514,6 +2542,11 @@ and gen_expression ctx retval expression =
          output "HX_STACK_DO_THROW(";
          gen_expression ctx true expression;
          output ")";
+   | TCast (cast,None) when is_objc_type expression.etype && not (is_objc_type cast.etype) ->
+     let ret_type = type_string expression.etype in
+     output ("( (" ^ ret_type ^ ") (NSObject *) (");
+     gen_expression ctx true cast;
+     output ") )"
    | TCast (cast,None) when (not retval) || (type_string expression.etype) = "Void" ->
       gen_expression ctx retval cast;
    | TCast (cast,None) ->
@@ -5638,6 +5671,12 @@ let generate_source common_ctx =
    let scriptable = (Common.defined common_ctx Define.Scriptable) in
 
    List.iter (fun object_def ->
+      (* check if any @:objc class is referenced while '-D objc' is not defined
+         This will guard all code changes to this flag *)
+      (if not (Common.defined common_ctx Define.Objc) then match object_def with
+         | TClassDecl class_def when Meta.has Meta.Objc class_def.cl_meta ->
+            error "In order to compile '@:objc' classes, please define '-D objc'" class_def.cl_pos
+         | _ -> ());
       (match object_def with
       | TClassDecl class_def when is_extern_class class_def ->
          build_xml := !build_xml ^ (get_class_code class_def Meta.BuildXml);

tests/misc/cppObjc/TestObjc.hx

@@ -2,16 +2,22 @@ class TestObjc extends haxe.unit.TestCase
 {
 	static function main()
 	{
+		var x:TestObjc = null;
+		trace(x);
+		var c:TestClass = null;
+		trace(c);
 		var runner = new haxe.unit.TestRunner();
 		runner.add(new TestObjc());
 		var code = runner.run() ? 0 : 1;
 		Sys.exit(code);
 	}
 
+	var cls:TestClass;
+
 	public function testCall()
 	{
 		assertEquals(TestClass.aStatic(), 42);
-		var cls = TestClass.alloc().init();
+		cls = TestClass.alloc().init();
 		assertEquals(cls.getOtherThing(), 0);
 		cls.setOtherThing(42);
 		assertEquals(cls.otherThing, 42);
@@ -28,14 +34,44 @@ class TestObjc extends haxe.unit.TestCase
 		assertEquals(cls.something, " test");
 		assertEquals(cls.addSomething("Hey,"), "Hey, test");
 		assertEquals(cls.addHelloAndString("World"," it works"), "Hello, World it works");
+		cls.release();
 	}
 
 	public function testVar()
 	{
-		var cls = TestClass.alloc().init();
+		cls = TestClass.alloc().init();
 		cls.setOtherThing(142);
 		assertEquals(cls.otherThing, 142);
 		assertEquals(cls.getOtherThing(), 142);
+		cls.release();
+	}
+
+	public function testBoxing()
+	{
+		cls = TestClass.alloc().init();
+
+		cls.setOtherThing(255);
+
+		var dyn:Dynamic = cls;
+		this.assertTrue(dyn != null);
+		this.assertTrue(cls != null);
+		cls.release();
+		cls = null;
+		this.assertTrue(cls == null);
+		cls = dyn;
+
+		assertEquals(cls.getOtherThing(), 255);
+		cls = null;
+		dyn = null;
+		dyn = cls;
+		assertTrue(dyn == null);
+		assertTrue(dyn == cls);
+	}
+
+	public function testNull()
+	{
+		this.assertTrue(TestClass.isNull(null));
+		this.assertFalse(TestClass.isNull(TestClass.alloc().init()));
 	}
 }
 
@@ -44,6 +80,7 @@ class TestObjc extends haxe.unit.TestCase
 @:objc extern class TestClass
 {
 	static function aStatic():Int;
+	static function isNull(t:TestClass):Bool;
 
 	static function alloc():TestClass;
 	function init():TestClass;
@@ -64,6 +101,8 @@ class TestObjc extends haxe.unit.TestCase
 	function isBiggerThan10Num(value:NSNumber):NSNumber;
 	function isBiggerThan10Int(integer:Int):Bool;
 
+	function release():Void;
+
 	@:plain static function some_c_call(t:TestClass):Int;
 	@:plain static function is_bigger_than_10(t:TestClass, val:Int):Bool;
 }

tests/misc/cppObjc/build.hxml

@@ -1,4 +1,4 @@
 -main TestObjc
 -cpp bin
--D file_extension=mm
 -debug
+-D objc

tests/misc/cppObjc/native/include/test.h

@@ -1,3 +1,5 @@
+#ifndef TEST_H_INCLUDED
+#define TEST_H_INCLUDED
 #import <Foundation/Foundation.h>
 
 @interface TestClass : NSObject {
@@ -8,6 +10,8 @@
 
 + (int)aStatic;
 
++ (BOOL)isNull:(TestClass *)t;
+
 - (void)setOtherThing:(int) value;
 
 - (int)getOtherThing;
@@ -32,3 +36,4 @@
 int some_c_call(TestClass *t);
 
 BOOL is_bigger_than_10(TestClass *t, int val);
+#endif

tests/misc/cppObjc/native/test.m

@@ -9,6 +9,11 @@
 	return 42;
 }
 
++ (BOOL)isNull:(TestClass *)t
+{
+	return t == nil;
+}
+
 - (void)setOtherThing:(int) value
 {
 	self->otherThing = value;