Support static blocks in blocks runtime

Author: dboris

CHANGES.md

@@ -1,3 +1,8 @@
+## dev
+
+* Support struct as method argument or return type
+* Support static blocks in blocks runtime
+
 ## v0.3.1
 
 * Improved libdispatch bindings

dispatch/blocks_runtime/blocks_runtime.ml

@@ -12,11 +12,15 @@ let make_descriptor ~size:s =
 let global_block_descriptor =
   make_descriptor ~size:(sizeof Block_layout.t) |> allocate Block_descriptor.t
 
-let make_block ~invoke:f =
+let make_block ?(is_global = true) f =
   let open Block_layout in
-  let b = make t in
-  setf b isa (to_voidp _NSConcreteGlobalBlock);
-  setf b flags _IS_GLOBAL;
+  let b = make t
+  and (btype, bflags) =
+    if is_global then (_NSConcreteGlobalBlock, _IS_GLOBAL)
+    else (_NSConcreteStackBlock, Int32.zero)
+  in
+  setf b isa (to_voidp btype);
+  setf b flags bflags;
   setf b descriptor global_block_descriptor;
   setf b invoke f;
   allocate t b |> to_voidp

dispatch/blocks_runtime/function_description.ml

@@ -10,6 +10,9 @@ module Functions (F : Ctypes.FOREIGN) = struct
   let _NSConcreteGlobalBlock =
     foreign_value "_NSConcreteGlobalBlock" (array 32 (ptr void))
 
+  let _NSConcreteStackBlock =
+    foreign_value "_NSConcreteStackBlock" (array 32 (ptr void))
+
   (** Create a heap based copy of a Block or simply add a reference to an
       existing one. This must be paired with Block_release to recover memory *)
   let _Block_copy = foreign "_Block_copy" (block_t @-> returning block_t)

test/test-camlkit-base/test_objc.ml

@@ -343,7 +343,7 @@ let test_struct_t () =
           ~cmd: (selector "someMethodWithStruct:")
           ~args: Objc_type.[struc CGPoint.t]
           ~return: Objc_type.void
-          (fun _self _cmd rect -> x := CGPoint.x rect)
+          (fun _self _cmd pt -> x := CGPoint.x pt)
         ]
   in
   let obj = _new_ my_class

test/test-dispatch/test_dispatch.ml

@@ -35,7 +35,19 @@ let test_block =
     Alcotest.(check bool "function called" true true))
   @@ fun f ->
   async' ~queue:main_queue
-    (make_block ~invoke:(coerce Block_fun.t (ptr void) f))
+    (make_block (coerce Block_fun.t (ptr void) f))
+
+let test_static_block =
+  "dispatch static block with async'" -: fun () ->
+  let module Block_fun =
+    (val Foreign.dynamic_funptr ~thread_registration:true ~runtime_lock:true
+            (void @-> returning void))
+  in
+  Block_fun.with_fun (fun () ->
+    Alcotest.(check bool "function called" true true))
+  @@ fun f ->
+  async' ~queue:main_queue
+    (make_block ~is_global:false (coerce Block_fun.t (ptr void) f))
 
 let test_dispatch_after =
   "time and after" -: fun () ->
@@ -89,6 +101,7 @@ let () =
         ; test_queue_concurrent
         ; test_queue_serial
         ; test_block
+        ; test_static_block
         ; test_dispatch_after
         ; test_with_delay
         ; test_async_and_wait