mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-27 20:53:48 +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 -
83 lines
1.9 KiB
ObjectPascal
83 lines
1.9 KiB
ObjectPascal
program tconstref3;
|
|
|
|
{$mode objfpc}{$h+}
|
|
|
|
uses
|
|
SysUtils;
|
|
|
|
const
|
|
CGuid: TGuid = '{67BD8D43-8960-491C-AA3A-50EC74A02F36}';
|
|
|
|
type
|
|
PSmallRecord = ^TSmallRecord;
|
|
TSmallRecord = record
|
|
p: PtrInt;
|
|
end;
|
|
|
|
PAclass = ^TAclass;
|
|
TAclass = class
|
|
public
|
|
p: PtrInt;
|
|
end;
|
|
|
|
procedure TestConstRefIntegerAlias(AParam: PInteger); [external name '_TESTCONSTREFINTEGER'];
|
|
procedure TestConstRefInteger(constref AParam: integer); [public, alias: '_TESTCONSTREFINTEGER'];
|
|
begin
|
|
if AParam<>$1234567 then
|
|
halt(1);
|
|
end;
|
|
|
|
procedure TestConstRefStringAlias(AParam: PString); [external name '_TESTCONSTREFSTRING'];
|
|
procedure TestConstRefString(constref AParam: String); [public, alias: '_TESTCONSTREFSTRING'];
|
|
begin
|
|
if AParam<>'1234567' then
|
|
halt(1);
|
|
end;
|
|
|
|
procedure TestConstRefGUIDAlias(AParam: PGuid); [external name '_TESTCONSTREFGUID'];
|
|
procedure TestConstRefGUID(constref AParam: TGuid); [public, alias: '_TESTCONSTREFGUID'];
|
|
begin
|
|
if GUIDToString(AParam)<>'{67BD8D43-8960-491C-AA3A-50EC74A02F36}' then
|
|
halt(1);
|
|
end;
|
|
|
|
procedure TestConstRefRecordAlias(AParam: PSmallRecord); [external name '_TESTCONSTREFRECORD'];
|
|
procedure TestConstRefRecord(constref AParam: TSmallRecord); [public, alias: '_TESTCONSTREFRECORD'];
|
|
begin
|
|
if AParam.p<>$7654321 then
|
|
halt(1);
|
|
end;
|
|
|
|
procedure TestConstRefClassAlias(AParam: PAClass); [external name '_TESTCONSTREFCLASS'];
|
|
procedure TestConstRefClass(constref AParam: TAClass); [public, alias: '_TESTCONSTREFCLASS'];
|
|
begin
|
|
if AParam.p<>$3456789 then
|
|
halt(1);
|
|
end;
|
|
|
|
var a: integer;
|
|
s: string;
|
|
p: tguid;
|
|
sr: TSmallRecord;
|
|
ac: TAclass;
|
|
|
|
begin
|
|
a := $1234567;
|
|
TestConstRefIntegerAlias(@a);
|
|
|
|
s := '1234567';
|
|
TestConstRefStringAlias(@s);
|
|
|
|
p := CGuid;
|
|
TestConstRefGUIDAlias(@p);
|
|
|
|
sr.p:=$7654321;
|
|
TestConstRefRecordAlias(@sr);
|
|
|
|
ac := TAclass.Create;
|
|
ac.p := $3456789;
|
|
TestConstRefClassAlias(@ac);
|
|
ac.Free;
|
|
end.
|
|
|