浏览代码

* verified some tests with Delphi XE
* added another bunch of tests (54-59)

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

svenbarth 14 年之前
父节点
当前提交
2462b5c84a

+ 6 - 0
.gitattributes

@@ -9368,6 +9368,12 @@ tests/test/tchlp50.pp svneol=native#text/pascal
 tests/test/tchlp51.pp svneol=native#text/pascal
 tests/test/tchlp51.pp svneol=native#text/pascal
 tests/test/tchlp52.pp svneol=native#text/pascal
 tests/test/tchlp52.pp svneol=native#text/pascal
 tests/test/tchlp53.pp svneol=native#text/pascal
 tests/test/tchlp53.pp svneol=native#text/pascal
+tests/test/tchlp54.pp svneol=native#text/pascal
+tests/test/tchlp55.pp svneol=native#text/pascal
+tests/test/tchlp56.pp svneol=native#text/pascal
+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/tchlp6.pp svneol=native#text/pascal
 tests/test/tchlp7.pp svneol=native#text/pascal
 tests/test/tchlp7.pp svneol=native#text/pascal
 tests/test/tchlp8.pp svneol=native#text/pascal
 tests/test/tchlp8.pp svneol=native#text/pascal

+ 2 - 2
tests/test/tchlp22.pp

@@ -1,10 +1,10 @@
 { %FAIL }
 { %FAIL }
 
 
-{ in mode Delphi overloading isn't enabled by default }
+{ overloading needs to be enabled explicitly }
 program tchlp22;
 program tchlp22;
 
 
 {$ifdef fpc}
 {$ifdef fpc}
-  {$mode delphi}
+  {$mode objfpc}
 {$endif}
 {$endif}
 
 
 type
 type

+ 7 - 3
tests/test/tchlp23.pp

@@ -1,7 +1,11 @@
-{ in mode ObjFPC overloading is enabled by default }
+{ %NORUN }
+
+{ overloading needs to be enabled explicitly }
 program tchlp23;
 program tchlp23;
 
 
-{$mode objfpc}
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
 
 
 type
 type
   TFoo = class
   TFoo = class
@@ -9,7 +13,7 @@ type
   end;
   end;
 
 
   TFooHelper = class helper for TFoo
   TFooHelper = class helper for TFoo
-    procedure Test;
+    procedure Test; overload;
   end;
   end;
 
 
 procedure TFoo.Test(const aTest: String);
 procedure TFoo.Test(const aTest: String);

+ 5 - 0
tests/test/tchlp35.pp

@@ -1,6 +1,11 @@
 { tests virtual methods inside class helpers }
 { tests virtual methods inside class helpers }
 program tchlp35;
 program tchlp35;
 
 
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
 uses
 uses
   uchlp35;
   uchlp35;
 
 

+ 1 - 1
tests/test/tchlp36.pp

@@ -20,7 +20,7 @@ type
 
 
   end;
   end;
 
 
-  TFooHelper = class helper(TFooHelper) for TFoo
+  TFooHelper = class helper(TBarHelper) for TFoo
   end;
   end;
 
 
 procedure TBarHelper.Test;
 procedure TBarHelper.Test;

+ 3 - 3
tests/test/tchlp39.pp

@@ -1,4 +1,4 @@
-{ the parent of a class helper has higher priority than the extended class when
+{ the extended class has higher priority than the parent class when
   searching for symbols }
   searching for symbols }
 program tchlp39;
 program tchlp39;
 
 
@@ -33,7 +33,7 @@ end;
 function TFooSubHelper.Test(aRecurse: Boolean): Integer;
 function TFooSubHelper.Test(aRecurse: Boolean): Integer;
 begin
 begin
   if aRecurse then
   if aRecurse then
-    Result := Test(False)
+    Result := inherited Test(False)
   else
   else
     Result := 3;
     Result := 3;
 end;
 end;
@@ -45,7 +45,7 @@ begin
   f := TFoo.Create;
   f := TFoo.Create;
   res := f.Test(True);
   res := f.Test(True);
   Writeln('f.Test: ', res);
   Writeln('f.Test: ', res);
-  if res <> 2 then
+  if res <> 1 then
     Halt(1);
     Halt(1);
   Writeln('ok');
   Writeln('ok');
 end.
 end.

+ 5 - 1
tests/test/tchlp43.pp

@@ -1,3 +1,5 @@
+{ the extended type is searched first for a inherited method even if it's
+  defined as "override" }
 program tchlp43;
 program tchlp43;
 
 
 {$ifdef fpc}
 {$ifdef fpc}
@@ -38,10 +40,12 @@ end;
 
 
 var
 var
   f: TFoo;
   f: TFoo;
+  res: Integer;
 begin
 begin
   f := TFoo.Create;
   f := TFoo.Create;
   res := f.Test(True);
   res := f.Test(True);
-  if res <> 2 then
+  Writeln('f.Test: ', res);
+  if res <> 1 then
     Halt(1);
     Halt(1);
   Writeln('ok');
   Writeln('ok');
 end.
 end.

+ 1 - 1
tests/test/tchlp45.pp

@@ -1,6 +1,6 @@
 { %FAIL }
 { %FAIL }
 
 
-{ access to methods must adhere to visibility rules }
+{ access to methods must adhere to visibility rules (here: strict private) }
 program tchlp45;
 program tchlp45;
 
 
 {$ifdef fpc}
 {$ifdef fpc}

+ 6 - 1
tests/test/tchlp51.pp

@@ -2,6 +2,11 @@
   implementation section overrides the one introduced in the interface section }
   implementation section overrides the one introduced in the interface section }
 program tchlp51;
 program tchlp51;
 
 
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+{$apptype console}
+
 uses
 uses
   uchlp51a, uchlp51c;
   uchlp51a, uchlp51c;
 
 
@@ -12,7 +17,7 @@ begin
   f := TFoo.Create;
   f := TFoo.Create;
   res := f.AccessTest;
   res := f.AccessTest;
   Writeln('f.AccessTest: ', res);
   Writeln('f.AccessTest: ', res);
-  if res <> 2 then
+  if res <> 1 then
     Halt(1);
     Halt(1);
   Writeln('ok');
   Writeln('ok');
 end.
 end.

+ 3 - 1
tests/test/tchlp52.pp

@@ -3,7 +3,9 @@
 { class helpers may not be referenced in any way - test 7 }
 { class helpers may not be referenced in any way - test 7 }
 program tchlp52;
 program tchlp52;
 
 
-{$mode objfpc}
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
 
 
 type
 type
   TObjectHelper = class helper for TObject
   TObjectHelper = class helper for TObject

+ 3 - 2
tests/test/tchlp53.pp

@@ -1,9 +1,10 @@
-{ %NORUN } { or fail? }
+{ %NORUN }
 
 
+{ method modifiers of the extended class are completly irrelevant }
 program tchlp53;
 program tchlp53;
 
 
 {$ifdef fpc}
 {$ifdef fpc}
-  {$mode objfpc}
+  {$mode delphi}
 {$endif}
 {$endif}
 
 
 type
 type

+ 33 - 0
tests/test/tchlp54.pp

@@ -0,0 +1,33 @@
+{ tests whether the methods of a parent helper are usable in a derived helper }
+program tchlp54;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+
+  end;
+
+  TFooHelper = class helper for TFoo
+    procedure Test;
+  end;
+
+  TFooBarHelper = class helper(TFooHelper) for TFoo
+    procedure AccessTest;
+  end;
+
+procedure TFooHelper.Test;
+begin
+
+end;
+
+procedure TFooBarHelper.AccessTest;
+begin
+  Test;
+end;
+
+begin
+end.

+ 26 - 0
tests/test/tchlp55.pp

@@ -0,0 +1,26 @@
+program tchlp55;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TTest = class
+  strict private
+    type
+      TFooHelper = class helper for TObject
+        procedure Test;
+      end;
+  end;
+
+procedure TTest.TFooHelper.Test;
+begin
+
+end;
+
+var
+  o: TObject;
+begin
+  o := TObject.Create;
+  o.Test;
+end.

+ 34 - 0
tests/test/tchlp56.pp

@@ -0,0 +1,34 @@
+{ %NORUN }
+
+{ for helpers Self always refers to the extended class }
+program tchlp56;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TFoo = class
+    procedure DoFoo(aFoo: TFoo);
+  end;
+
+  TFooHelper = class helper for TFoo
+    procedure Test;
+  end;
+
+procedure TFoo.DoFoo(aFoo: TFoo);
+begin
+
+end;
+
+procedure TFooHelper.Test;
+begin
+  DoFoo(Self);
+end;
+
+var
+  f: TFoo;
+begin
+  f := TFoo.Create;
+  f.Test;
+end.

+ 30 - 0
tests/test/tchlp57.pp

@@ -0,0 +1,30 @@
+{ %NORUN }
+
+{ a class helper can already be accessed when implementing a class' methods }
+program tchlp57;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TFoo = class
+    procedure Test;
+  end;
+
+  TFooHelper = class helper for TFoo
+    procedure Bar;
+  end;
+
+procedure TFoo.Test;
+begin
+  Bar;
+end;
+
+procedure TFooHelper.Bar;
+begin
+
+end;
+
+begin
+end.

+ 31 - 0
tests/test/tchlp58.pp

@@ -0,0 +1,31 @@
+{ %NORUN }
+
+{ tests whether class helpers can introduce properties }
+program tchlp58;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    Test: Integer;
+  end;
+
+  TFooHelper = class helper for TFoo
+    function GetAccessTest: Integer;
+    property AccessTest: Integer read GetAccessTest;
+  end;
+
+function TFooHelper.GetAccessTest: Integer;
+begin
+  Result := Test;
+end;
+
+var
+  f: TFoo;
+begin
+  f := TFoo.Create;
+  f.AccessTest;
+end.

+ 23 - 0
tests/test/tchlp59.pp

@@ -0,0 +1,23 @@
+{ %FAIL }
+
+{ inside a helper's declaration the methods/fields of the extended class can't
+  be accessed }
+program tchlp59;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    Test: Integer;
+    function GetTest: Integer;
+  end;
+
+  TFooHelper = class helper for TFoo
+    property AccessTest: Integer read Test;
+  end;
+
+begin
+end.

+ 4 - 2
tests/test/uchlp50.pp

@@ -1,6 +1,8 @@
 unit uchlp50; 
 unit uchlp50; 
 
 
-{$mode objfpc}{$H+}
+{$ifdef fpc}
+  {$mode objfpc}{$H+}
+{$endif}
 
 
 interface
 interface
 
 
@@ -23,7 +25,7 @@ begin
   Result := 1;
   Result := 1;
 end;
 end;
 
 
-function TFooHelper.Test: Integer;
+function TFooHelper2.Test: Integer;
 begin
 begin
   Result := 2;
   Result := 2;
 end;
 end;

+ 3 - 1
tests/test/uchlp51a.pp

@@ -1,6 +1,8 @@
 unit uchlp51a;
 unit uchlp51a;
 
 
-{$mode objfpc}{$H+}
+{$ifdef fpc}
+  {$mode objfpc}{$H+}
+{$endif}
 
 
 interface
 interface