diff --git a/tests/test/tdispinterface2.pp b/tests/test/tdispinterface2.pp index 2cc8fcea32..bacc4fcff1 100644 --- a/tests/test/tdispinterface2.pp +++ b/tests/test/tdispinterface2.pp @@ -16,22 +16,40 @@ type property Disp1: integer; procedure Disp2; property Disp402: wordbool dispid 402; + procedure DispArg1(Arg: IUnknown); + procedure DispArg2(Arg: IDispatch); + procedure DispArg3(var Arg: wordbool); end; var cur_dispid: longint; + cur_argtype: byte; {$HINTS OFF} -procedure DoDispCallByID(res : Pointer; const disp : IDispatch;desc : PDispDesc; params : Pointer); -begin - if desc^.dispid <> cur_dispid then - halt(cur_dispid); -end; + procedure DoDispCallByID(res: Pointer; const disp: IDispatch; desc: PDispDesc; + params: Pointer); + begin + if desc^.dispid <> cur_dispid then + halt(cur_dispid); + end; + + procedure DoDispCallByIDArg(res: Pointer; const disp: IDispatch; desc: PDispDesc; + params: Pointer); + begin + if desc^.calldesc.argcount <> 1 then + halt(4); + if desc^.calldesc.argtypes[0] <> cur_argtype then + halt(cur_argtype); + end; + + {$HINTS ON} var II: IIE; + B: wordbool; begin + // check dispid values DispCallByIDProc := @DoDispCallByID; cur_dispid := 300; II.Disp300; @@ -41,4 +59,13 @@ begin II.Disp2; cur_dispid := 402; II.Disp402 := True; + // check arguments + DispCallByIDProc := @DoDispCallByIDArg; + cur_argtype := varunknown; + II.DispArg1(nil); + cur_argtype := vardispatch; + II.DispArg2(nil); + cur_argtype := varboolean or $80; + B := False; + II.DispArg3(B); end. \ No newline at end of file