2
0
Эх сурвалжийг харах

More tests:
* for inherited (complicated search logic there...)
* generics
* sizeof (*sigh*)

git-svn-id: branches/svenbarth/classhelpers@17069 -

svenbarth 14 жил өмнө
parent
commit
6871e9ca72

+ 20 - 0
.gitattributes

@@ -9394,8 +9394,28 @@ tests/test/tchlp57.pp svneol=native#text/pascal
 tests/test/tchlp58.pp svneol=native#text/pascal
 tests/test/tchlp59.pp svneol=native#text/pascal
 tests/test/tchlp6.pp svneol=native#text/pascal
+tests/test/tchlp61.pp svneol=native#text/pascal
+tests/test/tchlp62.pp svneol=native#text/pascal
+tests/test/tchlp63.pp svneol=native#text/pascal
+tests/test/tchlp64.pp svneol=native#text/pascal
+tests/test/tchlp65.pp svneol=native#text/pascal
+tests/test/tchlp66.pp svneol=native#text/pascal
+tests/test/tchlp67.pp svneol=native#text/pascal
+tests/test/tchlp68.pp svneol=native#text/pascal
+tests/test/tchlp69.pp svneol=native#text/pascal
 tests/test/tchlp7.pp svneol=native#text/pascal
+tests/test/tchlp70.pp svneol=native#text/pascal
+tests/test/tchlp71.pp svneol=native#text/pascal
+tests/test/tchlp72.pp svneol=native#text/pascal
+tests/test/tchlp73.pp svneol=native#text/pascal
+tests/test/tchlp74.pp svneol=native#text/pascal
+tests/test/tchlp75.pp svneol=native#text/pascal
+tests/test/tchlp76.pp svneol=native#text/pascal
+tests/test/tchlp77.pp svneol=native#text/pascal
+tests/test/tchlp78.pp svneol=native#text/pascal
+tests/test/tchlp79.pp svneol=native#text/pascal
 tests/test/tchlp8.pp svneol=native#text/pascal
+tests/test/tchlp80.pp svneol=native#text/pascal
 tests/test/tchlp9.pp svneol=native#text/pascal
 tests/test/tcint64.pp svneol=native#text/plain
 tests/test/tclass1.pp svneol=native#text/plain

+ 46 - 0
tests/test/tchlp61.pp

@@ -0,0 +1,46 @@
+{ test that helpers can access the methods of the parent helper using
+  "inherited" }
+program tchlp61;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+
+  end;
+
+  TFooHelper = class helper for TFoo
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+  TFooBarHelper = class helper(TFooHelper) for TFoo
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+function TFooHelper.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 1;
+end;
+
+function TFooBarHelper.Test(aRecurse: Boolean): Integer;
+begin
+  if aRecurse then
+    Result := inherited Test(False)
+  else
+    Result := 2;
+end;
+
+var
+  f: TFoo;
+  res: Integer;
+begin
+  f := TFoo.Create;
+  res := f.Test(True);
+  Writeln('f.Test: ', res);
+  if res <> 1 then
+    Halt(1);
+  Writeln('ok');
+end.

+ 51 - 0
tests/test/tchlp62.pp

@@ -0,0 +1,51 @@
+{ a method defined in a parent helper has higher priority than a method defined
+  in the parent of the extended class - test 1}
+program tchlp62;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    function Test: Integer;
+  end;
+
+  TFooBar = class(TFoo)
+  end;
+
+  TFooBarHelper = class helper for TFooBar
+    function Test: Integer;
+  end;
+
+  TFooBarSubHelper = class helper(TFooBarHelper) for TFooBar
+    function AccessTest: Integer;
+  end;
+
+function TFoo.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TFooBarHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+function TFooBarSubHelper.AccessTest: Integer;
+begin
+  Result := Test;
+end;
+
+var
+  f: TFooBar;
+  res: Integer;
+begin
+  f := TFooBar.Create;
+  res := f.AccessTest;
+  Writeln('f.AccessTest: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

+ 51 - 0
tests/test/tchlp63.pp

@@ -0,0 +1,51 @@
+{ a method defined in a parent helper has higher priority than a method defined
+  in the parent of the extended class - test 2 }
+program tchlp63;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    function Test: Integer;
+  end;
+
+  TFooBar = class(TFoo)
+  end;
+
+  TFooBarHelper = class helper for TFooBar
+    function Test: Integer;
+  end;
+
+  TFooBarSubHelper = class helper(TFooBarHelper) for TFooBar
+    function AccessTest: Integer;
+  end;
+
+function TFoo.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TFooBarHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+function TFooBarSubHelper.AccessTest: Integer;
+begin
+  Result := inherited Test;
+end;
+
+var
+  f: TFooBar;
+  res: Integer;
+begin
+  f := TFooBar.Create;
+  res := f.AccessTest;
+  Writeln('f.AccessTest: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

+ 46 - 0
tests/test/tchlp64.pp

@@ -0,0 +1,46 @@
+{ a class helper can access methods defined in the parent of the extended
+  class }
+program tchlp64;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+  TFooBar = class(TFoo)
+  end;
+
+  TFooBarHelper = class helper for TFooBar
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+function TFoo.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 1;
+end;
+
+function TFooBarHelper.Test(aRecurse: Boolean): Integer;
+begin
+  if aRecurse then
+    Result := inherited Test(False)
+  else
+    Result := 2;
+end;
+
+var
+  f: TFooBar;
+  res: Integer;
+begin
+  f := TFooBar.Create;
+  res := f.Test(True);
+  Writeln('f.Test: ', res);
+  if res <> 1 then
+    Halt(1);
+  Writeln('ok');
+end.
+

+ 41 - 0
tests/test/tchlp65.pp

@@ -0,0 +1,41 @@
+{ without "inherited" the methods of the helper are called first }
+program tchlp65;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+  TFooHelper = class helper for TFoo
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+function TFoo.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 1;
+end;
+
+function TFooHelper.Test(aRecurse: Boolean): Integer;
+begin
+  if aRecurse then
+    Result := Test(False)
+  else
+    Result := 2;
+end;
+
+var
+  f: TFoo;
+  res: Integer;
+begin
+  f := TFoo.Create;
+  res := f.Test(True);
+  Writeln('f.Test: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

+ 47 - 0
tests/test/tchlp66.pp

@@ -0,0 +1,47 @@
+{ methods defined in a helper have higher priority than those defined in the
+  extended type }
+program tchlp66;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    function Test: Integer;
+  end;
+
+  TFooHelper = class helper for TFoo
+  private
+    function Test: Integer;
+  public
+    function AccessTest: Integer;
+  end;
+
+function TFoo.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TFooHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+function TFooHelper.AccessTest: Integer;
+begin
+  Result := Test;
+end;
+
+var
+  f: TFoo;
+  res: Integer;
+begin
+  f := TFoo.Create;
+  res := f.AccessTest;
+  Writeln('f.AccessTest: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

+ 47 - 0
tests/test/tchlp67.pp

@@ -0,0 +1,47 @@
+{ helper methods also influence calls to a parent's method in a derived class }
+program tchlp67;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    function Test: Integer;
+  end;
+
+  TFooBar = class(TFoo)
+    function AccessTest: Integer;
+  end;
+
+  TFooHelper = class helper for TFoo
+    function Test: Integer;
+  end;
+
+function TFoo.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TFooBar.AccessTest: Integer;
+begin
+  Result := Test;
+end;
+
+function TFooHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+var
+  f: TFooBar;
+  res: Integer;
+begin
+  f := TFooBar.Create;
+  res := f.AccessTest;
+  Writeln('f.AccessTest: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

+ 48 - 0
tests/test/tchlp68.pp

@@ -0,0 +1,48 @@
+{ helper methods also influence calls to a parent's method in a derived class }
+program tchlp68;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    function Test: Integer;
+  end;
+
+  TFooBar = class(TFoo)
+    function AccessTest: Integer;
+  end;
+
+  TFooHelper = class helper for TFoo
+    function Test: Integer;
+  end;
+
+function TFoo.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TFooBar.AccessTest: Integer;
+begin
+  Result := inherited Test;
+end;
+
+function TFooHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+var
+  f: TFooBar;
+  res: Integer;
+begin
+  f := TFooBar.Create;
+  res := f.AccessTest;
+  Writeln('f.AccessTest: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.
+

+ 21 - 0
tests/test/tchlp69.pp

@@ -0,0 +1,21 @@
+{ %FAIL }
+
+{ a helper can not extend inline defined generics }
+program tchlp69;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo<T> = class
+    Field: T;
+  end;
+
+  TFooHelper = class helper for TFoo<Integer>
+  end;
+
+begin
+
+end.

+ 21 - 0
tests/test/tchlp70.pp

@@ -0,0 +1,21 @@
+{ %FAIL }
+
+{ a helper can not extend unspecialized generics }
+program tchlp70;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo<T> = class
+    Field: T;
+  end;
+
+  TFooHelper = class helper for TFoo<T>
+  end;
+
+begin
+
+end.

+ 22 - 0
tests/test/tchlp71.pp

@@ -0,0 +1,22 @@
+{ %FAIL }
+
+{ a helper can not extend specialized generics }
+program tchlp71;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo<T> = class
+    Field: T;
+  end;
+
+  TFooInteger = TFoo<Integer>;
+
+  TFooHelper = class helper for TFooInteger
+  end;
+
+begin
+end.

+ 26 - 0
tests/test/tchlp72.pp

@@ -0,0 +1,26 @@
+{ %NORUN }
+
+{ a helper can extend the subclass of a specialized generic }
+program tchlp72;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo<T> = class
+    Field: T;
+  end;
+
+  TFooInteger = TFoo<Integer>;
+
+  TFooBar = class(TFooInteger)
+
+  end;
+
+  TFooHelper = class helper for TFooBar
+  end;
+
+begin
+end.

+ 27 - 0
tests/test/tchlp73.pp

@@ -0,0 +1,27 @@
+{ %FAIL }
+
+{ a helper may not be defined as a generic type }
+program tchlp73;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+
+  end;
+
+  TFooHelper<T> = class helper for TFoo
+    function Test: T;
+  end;
+
+function TFooHelper<T>.Test: T;
+begin
+
+end;
+
+begin
+
+end.

+ 28 - 0
tests/test/tchlp74.pp

@@ -0,0 +1,28 @@
+{ %SKIP }
+{ .%NORUN }
+
+{ a helper may contain generic methods }
+program tchlp74;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+
+  end;
+
+  TFooHelper = class helper for TFoo
+    function Test<T>: T;
+  end;
+
+function TFooHelper.Test<T>: T;
+begin
+
+end;
+
+begin
+
+end.

+ 21 - 0
tests/test/tchlp75.pp

@@ -0,0 +1,21 @@
+{ %SKIP }
+{ .%FAIL }
+
+{ helpers can not extend type parameters even if they can only be classes }
+program tchlp75;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo<T: class> = class
+  type
+    THelper = class helper for T
+    end;
+  end;
+
+begin
+
+end.

+ 34 - 0
tests/test/tchlp76.pp

@@ -0,0 +1,34 @@
+{ helpers may introduce new default properties }
+program tchlp76;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+
+  end;
+
+  TFooHelper = class helper for TFoo
+    function GetTest(aIndex: Integer): Integer;
+    property Test[Index: Integer]: Integer read GetTest; default;
+  end;
+
+function TFooHelper.GetTest(aIndex: Integer): Integer;
+begin
+  Result := aIndex;
+end;
+
+var
+  f: TFoo;
+  res: Integer;
+begin
+  f := TFoo.Create;
+  res := f[3];
+  Writeln('value: ', res);
+  if res <> 3 then
+    Halt(1);
+  Writeln('ok');
+end.

+ 42 - 0
tests/test/tchlp77.pp

@@ -0,0 +1,42 @@
+{ helpers may override existing default properties }
+program tchlp77;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+  private
+    function GetTest(aIndex: Integer): Integer;
+  public
+    property Test[Index: Integer]: Integer read GetTest; default;
+  end;
+
+  TFooHelper = class helper for TFoo
+    function GetTest(aIndex: Integer): Integer;
+    property Test[Index: Integer]: Integer read GetTest; default;
+  end;
+
+function TFoo.GetTest(aIndex: Integer): Integer;
+begin
+  Result := - aIndex;
+end;
+
+function TFooHelper.GetTest(aIndex: Integer): Integer;
+begin
+  Result := aIndex;
+end;
+
+var
+  f: TFoo;
+  res: Integer;
+begin
+  f := TFoo.Create;
+  res := f[3];
+  Writeln('value: ', res);
+  if res <> 3 then
+    Halt(1);
+  Writeln('ok');
+end.

+ 18 - 0
tests/test/tchlp78.pp

@@ -0,0 +1,18 @@
+{ size of a class helper is size of a pointer }
+program tchlp78;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TObjectHelper = class helper for TObject
+  end;
+
+begin
+  Writeln('Size of TObjectHelper: ', SizeOf(TObjectHelper));
+  if SizeOf(TObjectHelper) <> SizeOf(Pointer) then
+    Halt(1);
+  Writeln('ok');
+end.

+ 23 - 0
tests/test/tchlp79.pp

@@ -0,0 +1,23 @@
+{ size of a record helper is the size of a pointer }
+program tchlp79;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTestRecord = record
+    i: Integer;
+    j: Integer;
+  end;
+
+  TTestRecordHelper = record helper for TTestRecord
+  end;
+
+begin
+  Writeln('Size of TTestRecordHelper: ', SizeOf(TTestRecordHelper));
+  if SizeOf(TTestRecordHelper) <> SizeOf(Pointer) then
+    Halt(1);
+  Writeln('ok');
+end.

+ 50 - 0
tests/test/tchlp80.pp

@@ -0,0 +1,50 @@
+program tchlp80;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+uses
+  typinfo;
+
+type
+  TFoo = class
+
+  end;
+
+{$M+}
+  TFooHelper = class helper for TFoo
+  private
+    function GetTest: Integer;
+  published
+    property Test: Integer read GetTest;
+  end;
+{$M-}
+
+function TFooHelper.GetTest: Integer;
+begin
+  Result := 2;
+end;
+
+var
+  ti: PTypeInfo;
+  td: PTypeData;
+begin
+  ti := TypeInfo(TFooHelper);
+  if ti = Nil then begin
+    Writeln('TypeInfo is Nil');
+    Halt(1);
+  end;
+  if ti^.Kind = tkClass then begin
+    Writeln('Type kind is a class');
+    Writeln(ti^.Name);
+  end;
+  td := GetTypeData(ti);
+  if td = Nil then begin
+    Writeln('TypeData is Nil');
+    Halt(2);
+  end;
+  Writeln('Property count: ', td^.PropCount);
+  Writeln('ok');
+end.