Original bug ID: 1739
Reporter: administrator
Status: closed
Resolution: fixed
Priority: normal
Severity: minor
Category: -for CamlIDL use https://github.com/xavierleroy/camlidl/issues

Bug description

Let's consider the following example:

[--- unique_intf.idl ---]
[
object,
pointer_default(ref),
]
interface ITest: IUnknown
{
HRESULT f( [out,unique] ITest** i );
};
[--- end of unique_intf.idl ---]

camlidl generates

class iTest_class :
iTest Com.interface ->
object
method f: iTest Com.interface option
end

that's OK, but in C stub it forgets about "unique" attribute (option type)
and therefore the segfault happens:

HRESULT STDMETHODCALLTYPE camlidl_unique_intf_ITest_f_callback(
struct ITest * this,
/* out */ struct ITest **i)
{
value _varg[1] = { 0, };
value _vres;
static value _vlabel = 0;
HRESULT _res;
struct camlidl_ctx_struct _ctxs = { CAMLIDL_ADDREF, NULL };
camlidl_ctx _ctx = &_ctxs;
Begin_roots_block(_varg, 1)
_varg[0] = ((struct camlidl_intf *) this)->caml_object;
if (_vlabel == 0) _vlabel = camlidl_lookup_method("f");
End_roots();
_vres = callbackN_exn(Lookup(_varg[0], _vlabel), 1, _varg);
if (Is_exception_result(_vres))
return camlidl_result_exception("unique_intf.ITest::f", Extract_exception(_vres));
_res = S_OK;
*i = (struct ITest ) camlidl_unpack_interface(_vres, _ctx); / forgot about "unique" so segfault here! */
return _res;
}

I have made the following quick fix (or hack :-) that looks like solving
this problem:

Index: intf.ml

RCS file: /caml/bazar-ocaml/camlidl/compiler/intf.ml,v
retrieving revision 1.22
diff -u -r1.22 intf.ml
--- intf.ml 2002/01/16 09:42:02 1.22
+++ intf.ml 2003/07/03 02:40:31
@@ -283,6 +283,8 @@
let convert_output ty src dst =
match (dst, scrape_const ty) with
("_res", _) -> ml_to_c pc false pref ty src dst

• | (, Type_pointer(pty, Type_pointer(, Type_interface(modl, name)))) ->

•    ml_to_c pc false pref (Type_pointer(pty, Type_interface(modl, name))) src ("*" ^ dst)
  

  | (, Type_pointer(, ty')) -> ml_to_c pc false pref ty' src ("*" ^ dst)
  | (_, _) ->
  error (sprintf "Out parameter `%s' must be a pointer" dst) in

Now we have

HRESULT STDMETHODCALLTYPE camlidl_unique_intf_ITest_f_callback(
struct ITest * this,
/* out */ struct ITest **i)
{
value _varg[1] = { 0, };
value _vres;
static value _vlabel = 0;
HRESULT _res;
struct camlidl_ctx_struct _ctxs = { CAMLIDL_ADDREF, NULL };
camlidl_ctx _ctx = &_ctxs;
value _v1;
Begin_roots_block(_varg, 1)
_varg[0] = ((struct camlidl_intf *) this)->caml_object;
if (_vlabel == 0) _vlabel = camlidl_lookup_method("f");
End_roots();
_vres = callbackN_exn(Lookup(_varg[0], _vlabel), 1, _varg);
if (Is_exception_result(_vres))
return camlidl_result_exception("unique_intf.ITest::f", Extract_exception(_vres));
_res = S_OK;
if (_vres == Val_int(0)) {
*i = NULL;
} else {
_v1 = Field(_vres, 0);
*i = (struct ITest *) camlidl_unpack_interface(_v1, _ctx);
}
return _res;
}

that matches the definition.

• Dmitry Bely