Add tests for generic functions/procedures/methods

git-svn-id: trunk@32440 -

.gitattributes

@@ -12242,6 +12242,21 @@ tests/test/tgeneric96.pp svneol=native#text/pascal
 tests/test/tgeneric97.pp svneol=native#text/pascal
 tests/test/tgeneric98.pp svneol=native#text/pascal
 tests/test/tgeneric99.pp svneol=native#text/pascal
+tests/test/tgenfunc1.pp svneol=native#text/pascal
+tests/test/tgenfunc10.pp svneol=native#text/pascal
+tests/test/tgenfunc11.pp svneol=native#text/pascal
+tests/test/tgenfunc12.pp svneol=native#text/pascal
+tests/test/tgenfunc13.pp svneol=native#text/pascal
+tests/test/tgenfunc14.pp svneol=native#text/pascal
+tests/test/tgenfunc15.pp svneol=native#text/pascal
+tests/test/tgenfunc2.pp svneol=native#text/pascal
+tests/test/tgenfunc3.pp svneol=native#text/pascal
+tests/test/tgenfunc4.pp svneol=native#text/pascal
+tests/test/tgenfunc5.pp svneol=native#text/pascal
+tests/test/tgenfunc6.pp svneol=native#text/pascal
+tests/test/tgenfunc7.pp svneol=native#text/pascal
+tests/test/tgenfunc8.pp svneol=native#text/pascal
+tests/test/tgenfunc9.pp svneol=native#text/pascal
 tests/test/tgoto.pp svneol=native#text/plain
 tests/test/theap.pp svneol=native#text/plain
 tests/test/theapthread.pp svneol=native#text/plain
@@ -12896,6 +12911,7 @@ tests/test/ugeneric96b.pp svneol=native#text/pascal
 tests/test/ugeneric96c.pp svneol=native#text/pascal
 tests/test/ugeneric96d.pp svneol=native#text/pascal
 tests/test/ugeneric99.pp svneol=native#text/pascal
+tests/test/ugenfunc7.pp svneol=native#text/pascal
 tests/test/uhintdir.pp svneol=native#text/plain
 tests/test/uhlp3.pp svneol=native#text/pascal
 tests/test/uhlp31.pp svneol=native#text/pascal

tests/test/tgenfunc1.pp

@@ -0,0 +1,17 @@
+{ test syntax of a global generic function in mode objfpc }
+
+program tgenfunc1;
+
+{$mode objfpc}
+
+generic function Add<T>(aLeft, aRight: T): T;
+begin
+  Result := aLeft + aRight;
+end;
+
+begin
+  if specialize Add<LongInt>(2, 3) <> 5 then
+    Halt(1);
+  if specialize Add<String>('Hello', 'World') <> 'HelloWorld' then
+    Halt(2);
+end.

tests/test/tgenfunc10.pp

@@ -0,0 +1,50 @@
+{ %NORUN }
+
+{ ensure that specializations with local types are handled correctly }
+
+program tgenfunc10;
+
+{$mode objfpc}
+
+operator := (aOther: LongInt): String;
+begin
+  Str(aOther, Result);
+end;
+
+generic function Test<T>(aArg: T): String;
+begin
+  Result := aArg.Test;
+end;
+
+procedure Test1;
+type
+  TTest = record
+    Test: LongInt;
+  end;
+
+var
+  s: String;
+  t: TTest;
+begin
+  t.Test := 42;
+  s := specialize Test<TTest>(t);
+end;
+
+procedure Test2;
+type
+  TTest = record
+    Test: String;
+  end;
+
+var
+  s: String;
+  t: TTest;
+begin
+  t.Test := 'Hello World';
+  s := specialize Test<TTest>(t);
+end;
+
+begin
+  Test1;
+  Test2;
+end.

tests/test/tgenfunc11.pp

@@ -0,0 +1,18 @@
+{ %FAIL }
+
+program tgenfunc11;
+
+{$mode objfpc}
+
+type
+  TTest = class
+    generic procedure Test<T>; virtual;
+  end;
+
+generic procedure TTest.Test<T>;
+begin
+end;
+
+begin
+
+end.

tests/test/tgenfunc12.pp

@@ -0,0 +1,26 @@
+program tgenfunc12;
+
+{$mode objfpc}
+
+type
+  TTest = class
+    generic function Test<T: class>: T;
+  end;
+
+generic function TTest.Test<T>: T;
+begin
+  Result := T.Create;
+end;
+
+generic function Test<T: IInterface>: T;
+begin
+  Result := TInterfacedObject.Create;
+end;
+
+var
+  t: TTest;
+begin
+  t := TTest.Create;
+  t.specialize Test<TObject>.Free;
+  specialize Test<IInterface>;
+end.

tests/test/tgenfunc13.pp

@@ -0,0 +1,21 @@
+{ %FAIL }
+
+{ constraints must not be repeated in the definition }
+
+program tgenfunc13;
+
+{$mode objfpc}
+
+type
+  TTest = class
+    generic procedure Test<T: class>;
+  end;
+
+generic procedure TTest.Test<T: class>;
+begin
+
+end;
+
+begin
+
+end.

tests/test/tgenfunc14.pp

@@ -0,0 +1,21 @@
+{ %FAIL }
+
+unit tgenfunc14;
+
+{$mode objfpc}
+
+{ constraints must not be repeated in the definition }
+
+interface
+
+generic procedure Test<T: class>;
+
+implementation
+
+generic procedure Test<T: class>;
+begin
+
+end;
+
+end.
+

tests/test/tgenfunc15.pp

@@ -0,0 +1,45 @@
+{ correct match functions with array parameters of the generic type }
+
+unit tgenfunc15;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+  generic TStaticArray<T> = array[0..4] of T;
+
+  TTest = class
+    generic procedure Test<T>(aArg1: T; aArg2: array of T; aArg3: specialize TStaticArray<T>);
+    generic procedure Test<T>(aArg1: T; aArg2: array of T; aArg3: specialize TStaticArray<T>; aArg4: LongInt);
+  end;
+
+generic procedure Test<T>(aArg1: T; aArg2: array of T; aArg3: specialize TStaticArray<T>);
+generic procedure Test<T>(aArg1: T; aArg2: array of T; aArg3: specialize TStaticArray<T>; aArg4: LongInt);
+
+implementation
+
+generic procedure Test<T>(aArg1: T; aArg2: array of T; aArg3: specialize TStaticArray<T>);
+begin
+end;
+
+generic procedure Test<T>(aArg1: T; aArg2: array of T; aArg3: specialize TStaticArray<T>; aArg4: LongInt);
+begin
+end;
+
+generic procedure TTest.Test<T>(aArg1: T; aArg2: array of T; aArg3: specialize TStaticArray<T>);
+begin
+end;
+
+generic procedure TTest.Test<T>(aArg1: T; aArg2: array of T; aArg3: specialize TStaticArray<T>; aArg4: LongInt);
+begin
+end;
+
+var
+  t: array[0..4] of LongInt = (0, 1, 2, 3, 4);
+  s: array[0..4] of String = ('abc', 'def', 'ghi', 'jkl', 'mno');
+initialization
+  specialize Test<LongInt>(42, [32, 43], t);
+  specialize Test<String>('FPC', ['Hello', 'World'], s, 42);
+end.
+

tests/test/tgenfunc2.pp

@@ -0,0 +1,17 @@
+{ test syntax of a global generic function in mode delphi }
+
+program tgenfunc2;
+
+{$mode delphi}
+
+function Add<T>(aLeft, aRight: T): T;
+begin
+  Result := aLeft + aRight;
+end;
+
+begin
+  if Add<LongInt>(2, 3) <> 5 then
+    Halt(1);
+  if Add<String>('Hello', 'World') <> 'HelloWorld' then
+    Halt(2);
+end.

tests/test/tgenfunc3.pp

@@ -0,0 +1,22 @@
+{ test syntax of a generic class function in mode objfpc }
+
+program tgenfunc3;
+
+{$mode objfpc}
+
+type
+  TTest = class
+    generic class function Add<T>(aLeft, aRight: T): T;
+  end;
+
+generic class function TTest.Add<T>(aLeft, aRight: T): T;
+begin
+  Result := aLeft + aRight;
+end;
+
+begin
+  if TTest.specialize Add<LongInt>(2, 3) <> 5 then
+    Halt(1);
+  if TTest.specialize Add<String>('Hello', 'World') <> 'HelloWorld' then
+    Halt(2);
+end.

tests/test/tgenfunc4.pp

@@ -0,0 +1,22 @@
+{ test syntax of a generic class function in mode delphi }
+
+program tgenfunc4;
+
+{$mode delphi}
+
+type
+  TTest = class
+    class function Add<T>(aLeft, aRight: T): T;
+  end;
+
+class function TTest.Add<T>(aLeft, aRight: T): T;
+begin
+  Result := aLeft + aRight;
+end;
+
+begin
+  if TTest.Add<LongInt>(2, 3) <> 5 then
+    Halt(1);
+  if TTest.Add<String>('Hello', 'World') <> 'HelloWorld' then
+    Halt(2);
+end.

tests/test/tgenfunc5.pp

@@ -0,0 +1,24 @@
+{ test syntax of a generic method in mode objfpc }
+
+program tgenfunc5;
+
+{$mode objfpc}
+
+type
+  TTest = class
+    generic function Add<T>(aLeft, aRight: T): T;
+  end;
+
+generic function TTest.Add<T>(aLeft, aRight: T): T;
+begin
+  Result := aLeft + aRight;
+end;
+
+var
+  t: TTest;
+begin
+  if t.specialize Add<LongInt>(2, 3) <> 5 then
+    Halt(1);
+  if t.specialize Add<String>('Hello', 'World') <> 'HelloWorld' then
+    Halt(2);
+end.

tests/test/tgenfunc6.pp

@@ -0,0 +1,24 @@
+{ test syntax of a generic method in mode delphi }
+
+program tgenfunc6;
+
+{$mode delphi}
+
+type
+  TTest = class
+    function Add<T>(aLeft, aRight: T): T;
+  end;
+
+function TTest.Add<T>(aLeft, aRight: T): T;
+begin
+  Result := aLeft + aRight;
+end;
+
+var
+  t: TTest;
+begin
+  if t.Add<LongInt>(2, 3) <> 5 then
+    Halt(1);
+  if t.Add<String>('Hello', 'World') <> 'HelloWorld' then
+    Halt(2);
+end.

tests/test/tgenfunc7.pp

@@ -0,0 +1,26 @@
+{ generics in another unit work as well }
+
+program tgenfunc7;
+
+{$mode objfpc}
+
+uses
+  ugenfunc7;
+
+var
+  t: TTest;
+begin
+  if specialize Add<LongInt>(3, 4) <> 7 then
+    Halt(1);
+  if specialize Add<String>('Hello', 'World') <> 'HelloWorld' then
+    Halt(2);
+  if TTest.specialize AddClass<LongInt>(3, 4) <> 7 then
+    Halt(3);
+  if TTest.specialize AddClass<String>('Hello', 'World') <> 'HelloWorld' then
+    Halt(4);
+  if t.specialize Add<LongInt>(3, 4) <> 7 then
+    Halt(5);
+  if t.specialize Add<String>('Hello', 'World') <> 'HelloWorld' then
+    Halt(6);
+end.
+

tests/test/tgenfunc8.pp

@@ -0,0 +1,42 @@
+{ %NORUN }
+
+{ overloads with other generic functions work correctly }
+
+program tgenfunc8;
+
+{$mode objfpc}
+
+operator := (aOther: LongInt): String;
+begin
+  Str(aOther, Result);
+end;
+
+operator := (aOther: String): LongInt;
+var
+  code: LongInt;
+begin
+  Val(aOther, Result, code);
+end;
+
+generic function Add<T>(aLeft, aRight: T): T;
+begin
+  Result := aLeft + aRight;
+end;
+
+generic function Add<S, T>(aLeft, aRight: S): T;
+begin
+  Result := aLeft + aRight;
+end;
+
+generic function Add<T>(aLeft: T): T;
+begin
+  Result := aLeft + aLeft;
+end;
+
+begin
+  Writeln(specialize Add<LongInt>(4, 5));
+  Writeln(specialize Add<LongInt, String>(3, 8));
+  Writeln(specialize Add<String, LongInt>('3', '8'));
+  Writeln(specialize Add<LongInt>(2));
+  Writeln(specialize Add<String>('Test'));
+end.

tests/test/tgenfunc9.pp

@@ -0,0 +1,14 @@
+program tgenfunc9;
+
+uses
+  ugenfunc7;
+
+var
+  t: TTest;
+begin
+  t := TTest.Create;
+  Writeln(t.specialize GetStrictPrivate<LongInt>);
+  Writeln(t.specialize GetPrivate<LongInt>);
+  Writeln(t.specialize GetStrictProtected<LongInt>);
+  Writeln(t.specialize GetProtected<LongInt>);
+end.

tests/test/ugenfunc7.pp

@@ -0,0 +1,74 @@
+unit ugenfunc7;
+
+{$mode objfpc}
+
+interface
+
+type
+  TTest = class
+    constructor Create;
+    generic function Add<T>(aLeft, aRight: T): T;
+    generic class function AddClass<T>(aLeft, aRight: T): T;
+    generic function GetPrivate<T>: T;
+    generic function GetProtected<T>: T;
+    generic function GetStrictPrivate<T>: T;
+    generic function GetStrictProtected<T>: T;
+  strict private
+    fStrictPrivate: LongInt;
+  private
+    fPrivate: LongInt;
+  strict protected
+    fStrictProtected: LongInt;
+  protected
+    fProtected: LongInt;
+  end;
+
+generic function Add<T>(aLeft, aRight: T): T;
+
+implementation
+
+constructor TTest.Create;
+begin
+  fStrictPrivate := 1;
+  fPrivate := 2;
+  fStrictProtected := 3;
+  fProtected := 4;
+end;
+
+generic function TTest.Add<T>(aLeft, aRight: T): T;
+begin
+  Result := aLeft + aRight;
+end;
+
+generic class function TTest.AddClass<T>(aLeft, aRight: T): T;
+begin
+  Result := aLeft + aRight;
+end;
+
+generic function TTest.GetStrictPrivate<T>: T;
+begin
+  Result := fStrictPrivate;
+end;
+
+generic function TTest.GetPrivate<T>: T;
+begin
+  Result := fPrivate;
+end;
+
+generic function TTest.GetStrictProtected<T>: T;
+begin
+  Result := fStrictProtected;
+end;
+
+generic function TTest.GetProtected<T>: T;
+begin
+  Result := fProtected;
+end;
+
+generic function Add<T>(aLeft, aRight: T): T;
+begin
+  Result := aLeft + aRight;
+end;
+
+end.
+