Quellcode durchsuchen

* a bit of language consolidation: "type helper" can now be used for records and classes as well

git-svn-id: trunk@36938 -
svenbarth vor 8 Jahren
Ursprung
Commit
324e63b5d3
3 geänderte Dateien mit 189 neuen und 5 gelöschten Zeilen
  1. 1 0
      .gitattributes
  2. 12 5
      compiler/pdecobj.pas
  3. 176 0
      tests/test/tthlp23.pp

+ 1 - 0
.gitattributes

@@ -13356,6 +13356,7 @@ tests/test/tthlp2.pp svneol=native#text/pascal
 tests/test/tthlp20.pp svneol=native#text/pascal
 tests/test/tthlp21.pp svneol=native#text/pascal
 tests/test/tthlp22.pp svneol=native#text/pascal
+tests/test/tthlp23.pp svneol=native#text/pascal
 tests/test/tthlp3.pp svneol=native#text/pascal
 tests/test/tthlp4.pp svneol=native#text/pascal
 tests/test/tthlp5.pp svneol=native#text/pascal

+ 12 - 5
compiler/pdecobj.pas

@@ -701,8 +701,12 @@ implementation
 
       procedure validate_extendeddef_typehelper(var def:tdef);
         begin
-          if def.typ in [undefineddef,procvardef,procdef,objectdef,recorddef,
-              filedef,classrefdef,abstractdef,forwarddef,formaldef] then
+          if (def.typ in [undefineddef,procvardef,procdef,
+              filedef,classrefdef,abstractdef,forwarddef,formaldef]) or
+              (
+                (def.typ=objectdef) and
+                (tobjectdef(def).objecttype<>odt_class)
+              ) then
             begin
               Message1(type_e_type_not_allowed_for_type_helper,def.typename);
               def:=generrordef;
@@ -791,9 +795,12 @@ implementation
               ht_type:
                 begin
                   validate_extendeddef_typehelper(hdef);
-                  { a type helper must extend the same type as the
-                    parent helper }
-                  check_inheritance_record_type_helper(hdef);
+                  if is_class(hdef) then
+                    check_inheritance_class_helper(hdef)
+                  else
+                    { a type helper must extend the same type as the
+                      parent helper }
+                    check_inheritance_record_type_helper(hdef);
                 end;
             end;
           end;

+ 176 - 0
tests/test/tthlp23.pp

@@ -0,0 +1,176 @@
+{ %NORUN }
+
+{ type helpers in mode ObjFPC can also be used in place of record and class
+  helpers }
+
+program tthlp23;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{$modeswitch typehelpers}
+
+type
+  TTest = record
+    function Test: LongInt;
+    class function TestStatic: LongInt; static;
+  end;
+
+  TTestHelper = type helper for TTest
+    function Test: LongInt;
+    class function TestStatic: LongInt; static;
+  end;
+
+  TTestHelperSub = type helper(TTestHelper) for TTest
+    function Test: LongInt;
+    class function TestStatic: LongInt; static;
+  end;
+
+  TObjectHelper = type helper for TObject
+    function Test: LongInt;
+    class function TestClass: LongInt;
+    class function TestStatic: LongInt; static;
+  end;
+
+  TObjectHelperSub = type helper(TObjectHelper) for TObject
+    function Test: LongInt;
+    class function TestClass: LongInt;
+    class function TestStatic: LongInt; static;
+  end;
+
+  TObjectSub = class(TObject)
+    function Test: LongInt;
+    class function TestClass: LongInt;
+    class function TestStatic: LongInt; static;
+  end;
+
+  TObjectSubHelperSub = type helper(TObjectHelper) for TObjectSub
+    function Test: LongInt;
+    class function TestClass: LongInt;
+    class function TestStatic: LongInt; static;
+  end;
+
+function TTest.Test: LongInt;
+begin
+  Result := 1;
+end;
+
+class function TTest.TestStatic: LongInt;
+begin
+  Result := 2;
+end;
+
+function TTestHelper.Test: LongInt;
+begin
+  Result := 3;
+end;
+
+class function TTestHelper.TestStatic: LongInt;
+begin
+  Result := 4;
+end;
+
+function TTestHelperSub.Test: LongInt;
+begin
+  Result := 5;
+end;
+
+class function TTestHelperSub.TestStatic: LongInt;
+begin
+  Result := 6;
+end;
+
+function TObjectHelper.Test: LongInt;
+begin
+  Result := 7;
+end;
+
+class function TObjectHelper.TestClass: LongInt;
+begin
+  Result := 8;
+end;
+
+class function TObjectHelper.TestStatic: LongInt;
+begin
+  Result := 9;
+end;
+
+function TObjectHelperSub.Test: LongInt;
+begin
+  Result := 10;
+end;
+
+class function TObjectHelperSub.TestClass: LongInt;
+begin
+  Result := 11;
+end;
+
+class function TObjectHelperSub.TestStatic: LongInt;
+begin
+  Result := 12;
+end;
+
+function TObjectSub.Test: LongInt;
+begin
+  Result := 13;
+end;
+
+class function TObjectSub.TestClass: LongInt;
+begin
+  Result := 14;
+end;
+
+class function TObjectSub.TestStatic: LongInt;
+begin
+  Result := 15;
+end;
+
+function TObjectSubHelperSub.Test: LongInt;
+begin
+  Result := 16;
+end;
+
+class function TObjectSubHelperSub.TestClass: LongInt;
+begin
+  Result := 17;
+end;
+
+class function TObjectSubHelperSub.TestStatic: LongInt;
+begin
+  Result := 18;
+end;
+
+var
+  t: TTest;
+  o: TObject;
+  os: TObjectSub;
+begin
+  if t.Test <> 5 then
+    Halt(1);
+  if t.TestStatic <> 6 then
+    Halt(2);
+  if TTest.TestStatic <> 6 then
+    Halt(3);
+  o := TObject.Create;
+  if o.Test <> 10 then
+    Halt(4);
+  if o.TestClass <> 11 then
+    Halt(5);
+  if o.TestStatic <> 12 then
+    Halt(6);
+  if TObject.TestClass <> 11 then
+    Halt(7);
+  if TObject.TestStatic <> 12 then
+    Halt(8);
+  os := TObjectSub.Create;
+  if os.Test <> 16 then
+    Halt(9);
+  if os.TestClass <> 17 then
+    Halt(10);
+  if os.TestStatic <> 18 then
+    Halt(11);
+  if TObjectSub.TestClass <> 17 then
+    Halt(12);
+  if TObjectSub.TestStatic <> 18 then
+    Halt(13);
+  Writeln('ok');
+end.