Browse Source

tchlp37.pp: properties seem to be disliked by Delphi 2007 (when accessing them), so test using a function
tchlp50.pp+: added some more tests that yet need to be verified in Delphi

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

svenbarth 14 years ago
parent
commit
9b6fbd330c

+ 8 - 0
.gitattributes

@@ -9331,6 +9331,10 @@ tests/test/tchlp47.pp svneol=native#text/pascal
 tests/test/tchlp48.pp svneol=native#text/pascal
 tests/test/tchlp49.pp svneol=native#text/pascal
 tests/test/tchlp5.pp svneol=native#text/pascal
+tests/test/tchlp50.pp svneol=native#text/pascal
+tests/test/tchlp51.pp svneol=native#text/pascal
+tests/test/tchlp52.pp svneol=native#text/pascal
+tests/test/tchlp53.pp svneol=native#text/pascal
 tests/test/tchlp6.pp svneol=native#text/pascal
 tests/test/tchlp7.pp svneol=native#text/pascal
 tests/test/tchlp8.pp svneol=native#text/pascal
@@ -9876,6 +9880,10 @@ tests/test/uchlp33b.pp svneol=native#text/pascal
 tests/test/uchlp33c.pp svneol=native#text/pascal
 tests/test/uchlp35.pp svneol=native#text/pascal
 tests/test/uchlp45.pp svneol=native#text/pascal
+tests/test/uchlp50.pp svneol=native#text/pascal
+tests/test/uchlp51a.pp svneol=native#text/pascal
+tests/test/uchlp51b.pp svneol=native#text/pascal
+tests/test/uchlp51c.pp svneol=native#text/pascal
 tests/test/uenum2a.pp svneol=native#text/plain
 tests/test/uenum2b.pp svneol=native#text/plain
 tests/test/ugeneric10.pp svneol=native#text/plain

+ 6 - 1
tests/test/tchlp37.pp

@@ -16,7 +16,7 @@ type
   end;
 
   TFooBarHelper = class helper(TFooHelper) for TFoo
-    property AccessTest: Integer read Test;
+    function AccessTest: Integer;
   end;
 
 function TFoo.Test: Integer;
@@ -29,6 +29,11 @@ begin
   Result := 2;
 end;
 
+function TFooBarHelper.AccessTest: Integer;
+begin
+  Result := Test;
+end;
+
 var
   f: TFoo;
   res: Integer;

+ 24 - 0
tests/test/tchlp50.pp

@@ -0,0 +1,24 @@
+{ test whether the correct class helper is used, if two are defined for the
+  same class in a unit }
+program tchlp50;
+
+{$ifdef fpc}
+  {$mode objfpc}{$H+}
+{$endif}
+{$apptype console}
+
+uses
+  uchlp50;
+
+var
+  f: TFoo;
+  res: Integer;
+begin
+  f := TFoo.Create;
+  res := f.Test;
+  Writeln('f.Test: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.
+

+ 18 - 0
tests/test/tchlp51.pp

@@ -0,0 +1,18 @@
+{ this tests whether a class helper introduced in the uses clause of an
+  implementation section overrides the one introduced in the interface section }
+program tchlp51;
+
+uses
+  uchlp51a, uchlp51c;
+
+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.

+ 22 - 0
tests/test/tchlp52.pp

@@ -0,0 +1,22 @@
+{ %FAIL }
+
+{ class helpers may not be referenced in any way - test 7 }
+program tchlp52;
+
+{$mode objfpc}
+
+type
+  TObjectHelper = class helper for TObject
+    procedure Test;
+  end;
+
+procedure TObjectHelper.Test;
+begin
+
+end;
+
+var
+  o: TObject;
+begin
+  TObjectHelper(o).Test;
+end.

+ 39 - 0
tests/test/tchlp53.pp

@@ -0,0 +1,39 @@
+{ %NORUN } { or fail? }
+
+program tchlp53;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TFoo = class
+    procedure Test; virtual;
+  end;
+
+  TFooHelper = class helper for TFoo
+    procedure Test; virtual;
+  end;
+
+  TFooSubHelper = class helper(TFooHelper) for TFoo
+    procedure Test; override;
+  end;
+
+procedure TFoo.Test;
+begin
+
+end;
+
+procedure TFooHelper.Test;
+begin
+
+end;
+
+procedure TFooSubHelper.Test;
+begin
+
+end;
+
+begin
+
+end.

+ 32 - 0
tests/test/uchlp50.pp

@@ -0,0 +1,32 @@
+unit uchlp50; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+  TFoo = class
+  end;
+
+  TFooHelper1 = class helper for TFoo
+    function Test: Integer;
+  end;
+
+  TFooHelper2 = class helper for TFoo
+    function Test: Integer;
+  end;
+
+implementation
+
+function TFooHelper1.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TFooHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+end.
+

+ 20 - 0
tests/test/uchlp51a.pp

@@ -0,0 +1,20 @@
+unit uchlp51a;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+  TFoo = class
+    function Test: Integer;
+  end;
+
+implementation
+
+function TFoo.Test: Integer;
+begin
+  Result := 1;
+end;
+
+end.
+

+ 25 - 0
tests/test/uchlp51b.pp

@@ -0,0 +1,25 @@
+unit uchlp51b; 
+
+{$ifdef fpc}
+  {$mode objfpc}{$H+}
+{$endif}
+
+interface
+
+uses
+  uchlp51a;
+
+type
+  TFooHelper = class helper for TFoo
+    function Test: Integer;
+  end;
+
+implementation
+
+function TFooHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+end.
+

+ 28 - 0
tests/test/uchlp51c.pp

@@ -0,0 +1,28 @@
+unit uchlp51c; 
+
+{$ifdef fpc}
+  {$mode objfpc}{$H+}
+{$endif}
+
+interface
+
+uses
+  uchlp51a;
+
+type
+  TFooHelper2 = class helper for TFoo
+    function AccessTest: Integer;
+  end;
+
+implementation
+
+uses
+  uchlp51b;
+
+function TFooHelper2.AccessTest: Integer;
+begin
+  Result := Test;
+end;
+
+end.
+