* Added tests for constref support from r16008

git-svn-id: branches/xpcom@16074 -

.gitattributes

@@ -9143,6 +9143,10 @@ tests/test/tclassinfo1.pp svneol=native#text/pascal
 tests/test/tclrprop.pp svneol=native#text/plain
 tests/test/tcmp.pp svneol=native#text/plain
 tests/test/tcmp0.pp svneol=native#text/plain
+tests/test/tconstref1.pp svneol=native#text/pascal
+tests/test/tconstref2.pp svneol=native#text/pascal
+tests/test/tconstref3.pp svneol=native#text/pascal
+tests/test/tconstref4.pp svneol=native#text/pascal
 tests/test/tcstring1.pp svneol=native#text/pascal
 tests/test/tcstring2.pp svneol=native#text/pascal
 tests/test/tdel1.pp svneol=native#text/plain

tests/test/tconstref1.pp

@@ -0,0 +1,53 @@
+program tConstRef1;
+
+{$mode objfpc}{$h+}
+
+uses
+  Classes, SysUtils;
+
+type
+  TConstRefProc = procedure(constref AParam: integer);
+
+  TAClass = class(tobject)
+  private
+    function GetSomething(constref int:integer): integer;
+  public
+    property Something[constref int:integer] : integer read getSomething;
+  end;
+
+function TAClass.GetSomething(constref int: integer): integer;
+begin
+  if int<>$1234567 then
+    halt(1);
+  result := $54321;
+end;
+
+procedure TestConstRef(constref AParam: integer); [public, alias: '_TESTCONSTREF'];
+begin
+  if AParam<>$1234567 then
+    halt(1);
+end;
+
+procedure TestConstRefAlias(AParam: PInteger); [external name '_TESTCONSTREF'];
+
+const c = $1234567;
+var a: integer;
+    aclass: TAClass;
+    p: TConstRefProc;
+
+begin
+  a := $1234567;
+  TestConstRef(a);
+  TestConstRef(c);
+  TestConstRef($1234567);
+  TestConstRefAlias(@a);
+
+  aclass := TAClass.Create;
+  if aclass.Something[a]<>$54321 then
+    halt(1);
+  aclass.Free;
+
+  p := @TestConstRef;
+  p(c);
+end.
+

tests/test/tconstref2.pp

@@ -0,0 +1,12 @@
+{ %fail }
+program tConstRef2;
+
+procedure TestConstRef(constref AParam: integer);
+begin
+  AParam := 5;
+end;
+
+begin
+  TestConstRef(1);
+end.
+

tests/test/tconstref3.pp

@@ -0,0 +1,82 @@
+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.
+

tests/test/tconstref4.pp

@@ -0,0 +1,41 @@
+program tconstref4;
+
+{$mode objfpc}{$h+}
+
+procedure TestConstRefSafecallAlias(AParam: PInteger); safecall; [external name '_TESTCONSTREFSAFECALL'];
+procedure TestConstRefSafecall(constref AParam: integer); safecall; [public, alias: '_TESTCONSTREFSAFECALL'];
+begin
+  if AParam<>$1234567 then
+    halt(1);
+end;
+
+procedure TestConstRefCdeclAlias(AParam: PInteger); cdecl; [external name '_TESTCONSTREFCDECL'];
+procedure TestConstRefCdecl(constref AParam: integer); cdecl; [public, alias: '_TESTCONSTREFCDECL'];
+begin
+  if AParam<>$1234567 then
+    halt(1);
+end;
+
+procedure TestConstRefStdcallAlias(AParam: PInteger); cdecl; [external name '_TESTCONSTREFSTDCALL'];
+procedure TestConstRefStdcall(constref AParam: integer); cdecl; [public, alias: '_TESTCONSTREFSTDCALL'];
+begin
+  if AParam<>$1234567 then
+    halt(1);
+end;
+
+procedure TestConstRefRegisterAlias(AParam: PInteger); cdecl; [external name '_TESTCONSTREFREGISTER'];
+procedure TestConstRefRegister(constref AParam: integer); cdecl; [public, alias: '_TESTCONSTREFREGISTER'];
+begin
+  if AParam<>$1234567 then
+    halt(1);
+end;
+
+var a : integer;
+begin
+  a := $1234567;
+  TestConstRefSafecallAlias(@a);
+  TestConstRefStdcallAlias(@a);
+  TestConstRefRegisterAlias(@a);
+  TestConstRefCdeclAlias(@a);
+end.
+