Browse Source

* a type helper that inherits from another type helper may extend a unique type helper of the parent's extended type (thus allowing to make the type helper of the original type available for the aliased type)
+ added tests

Sven/Sarah Barth 2 năm trước cách đây
mục cha
commit
7133ad7ecc
3 tập tin đã thay đổi với 102 bổ sung0 xóa
  1. 11 0
      compiler/pdecobj.pas
  2. 72 0
      tests/test/tthlp30.pp
  3. 19 0
      tests/test/tthlp31.pp

+ 11 - 0
compiler/pdecobj.pas

@@ -730,11 +730,22 @@ implementation
         end;
 
       procedure check_inheritance_record_type_helper(var def:tdef);
+        var
+          tmp : tstoreddef;
         begin
           if (def.typ<>errordef) and assigned(current_objectdef.childof) then
             begin
               if def<>current_objectdef.childof.extendeddef then
                 begin
+                  { a type helper may extend a type alias of the type its
+                    parent type helper extends }
+                  tmp:=tstoreddef(def);
+                  while (df_unique in tmp.defoptions) and assigned(tstoreddef(tmp).orgdef) do
+                    begin
+                      if tmp.orgdef=current_objectdef.childof.extendeddef then
+                        exit;
+                      tmp:=tstoreddef(tmp.orgdef);
+                    end;
                   Message1(type_e_record_helper_must_extend_same_record,current_objectdef.childof.extendeddef.typename);
                   def:=generrordef;
                 end;

+ 72 - 0
tests/test/tthlp30.pp

@@ -0,0 +1,72 @@
+program tthlp30;
+
+{$mode objfpc}
+{$modeswitch typehelpers}
+
+type
+  Test1 = type LongInt;
+  Test2 = type LongInt;
+  Test3 = type Test1;
+
+  TLongIntHelper = type helper for LongInt
+    function TestA: LongInt;
+    function TestB: LongInt;
+  end;
+
+  TTest1Helper = type helper(TLongIntHelper) for Test1
+    function TestA: LongInt;
+  end;
+
+  TTest2Helper = type helper(TLongIntHelper) for Test2
+    function TestB: LongInt;
+  end;
+
+  TTest3Helper = type helper(TLongIntHelper) for Test3
+  end;
+
+function TTest2Helper.TestB: LongInt;
+begin
+  Result := 2;
+end;
+
+function TTest1Helper.TestA: LongInt;
+begin
+  Result := 2;
+end;
+
+function TLongIntHelper.TestA: LongInt;
+begin
+  Result := 1;
+end;
+
+function TLongIntHelper.TestB: LongInt;
+begin
+  Result := 1;
+end;
+
+var
+  l: LongInt;
+  t1: Test1;
+  t2: Test2;
+  t3: Test3;
+begin
+  if l.TestA <> 1 then
+    Halt(1);
+  if l.TestB <> 1 then
+    Halt(2);
+
+  if t1.TestA <> 2 then
+    Halt(3);
+  if t1.TestB <> 1 then
+    Halt(4);
+
+  if t2.TestA <> 1 then
+    Halt(5);
+  if t2.TestB <> 2 then
+    Halt(6);
+
+  if t3.TestA <> 1 then
+    Halt(7);
+  if t3.TestB <> 1 then
+    Halt(8);
+end.

+ 19 - 0
tests/test/tthlp31.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+
+program tthlp31;
+
+{$mode objfpc}
+{$modeswitch typehelpers}
+
+type
+  Test = type LongInt;
+
+  TTestHelper = type helper for Test
+  end;
+
+  TLongIntHelper = type helper(TTestHelper) for LongInt
+  end;
+
+begin
+
+end.