Skip to content
Snippets Groups Projects
Commit 7133ad7e authored by Sven/Sarah Barth's avatar Sven/Sarah Barth
Browse files

* a type helper that inherits from another type helper may extend a unique...

* 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
parent 62cc594c
No related branches found
No related tags found
No related merge requests found
......@@ -730,11 +730,22 @@ childof:=class_tobject;
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;
......
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.
{ %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.
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment