mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-16 00:19:29 +02:00
07bf44517c
the IInterface implementation to be XPCom-compatible --- Merging r15997 through r16179 into '.': U rtl/inc/variants.pp U rtl/inc/objpash.inc U rtl/inc/objpas.inc U rtl/objpas/classes/persist.inc U rtl/objpas/classes/compon.inc U rtl/objpas/classes/classesh.inc A tests/test/tconstref1.pp A tests/test/tconstref2.pp A tests/test/tconstref3.pp U tests/test/tinterface4.pp A tests/test/tconstref4.pp U tests/webtbs/tw10897.pp U tests/webtbs/tw4086.pp U tests/webtbs/tw15363.pp U tests/webtbs/tw2177.pp U tests/webtbs/tw16592.pp U tests/tbs/tb0546.pp U compiler/sparc/cpupara.pas U compiler/i386/cpupara.pas U compiler/pdecsub.pas U compiler/symdef.pas U compiler/powerpc/cpupara.pas U compiler/avr/cpupara.pas U compiler/browcol.pas U compiler/defcmp.pas U compiler/powerpc64/cpupara.pas U compiler/ncgrtti.pas U compiler/x86_64/cpupara.pas U compiler/opttail.pas U compiler/htypechk.pas U compiler/tokens.pas U compiler/objcutil.pas U compiler/ncal.pas U compiler/symtable.pas U compiler/symsym.pas U compiler/m68k/cpupara.pas U compiler/regvars.pas U compiler/arm/cpupara.pas U compiler/symconst.pas U compiler/mips/cpupara.pas U compiler/paramgr.pas U compiler/psub.pas U compiler/pdecvar.pas U compiler/dbgstabs.pas U compiler/options.pas U packages/fcl-fpcunit/src/testutils.pp git-svn-id: trunk@16180 -
66 lines
1.4 KiB
ObjectPascal
66 lines
1.4 KiB
ObjectPascal
{ %version=1.1 }
|
|
|
|
{ Source provided for Free Pascal Bug Report 2177 }
|
|
{ Submitted by "Rimgaudas" on 2002-10-14 }
|
|
{ e-mail: rimga@ktl.mii.lt }
|
|
{$ifdef fpc}{$mode delphi}{$endif}
|
|
|
|
uses
|
|
SysUtils;
|
|
|
|
type
|
|
ii= interface
|
|
['{616D9683-88DC-4D1C-B847-1293DDFBACF7}']
|
|
procedure Show;stdcall;
|
|
end;
|
|
|
|
Twii= class(TObject, ii)
|
|
s: string;
|
|
function QueryInterface(constref IID: TGUID; out Obj): Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
|
function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
|
function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
|
|
|
procedure Show;stdcall;
|
|
end;
|
|
|
|
{________doomy interfaces______}
|
|
function Twii.QueryInterface(constref IID: TGUID; out Obj): Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
|
begin
|
|
result:= -1;
|
|
end;
|
|
|
|
function Twii._AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
|
begin
|
|
result:= -1;
|
|
end;
|
|
|
|
function Twii._Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
|
begin
|
|
result:= -1;
|
|
end;
|
|
{________doomy interfaces______}
|
|
|
|
|
|
procedure Twii.Show;stdcall;
|
|
begin
|
|
WriteLn(s);
|
|
end;
|
|
|
|
var
|
|
wii: twii;
|
|
i: ii;
|
|
|
|
begin
|
|
try
|
|
wii:= Twii.create;
|
|
wii.s:='OK';
|
|
i:= ii(wii);
|
|
i.Show;
|
|
except //excepts
|
|
on EInvalidCast do WriteLn('Invalid Cast');
|
|
else
|
|
WriteLn('Problem');
|
|
halt(1);
|
|
end;
|
|
end.
|