Fix for Mantis #26599.

pgenutils.pas, check_generic_constraints:
  * correctly handle forward defs if the constraint is either a single IInterface/IUnknown or a TObject/class

+ added tests

git-svn-id: trunk@28601 -
This commit is contained in:
svenbarth 2014-09-05 14:42:22 +00:00
parent f8c7290dbb
commit 684c8842e7
7 changed files with 153 additions and 5 deletions

5
.gitattributes vendored
View File

@ -11541,7 +11541,11 @@ tests/test/tgenconstraint33.pp svneol=native#text/pascal
tests/test/tgenconstraint34.pp svneol=native#text/pascal
tests/test/tgenconstraint35.pp svneol=native#text/pascal
tests/test/tgenconstraint36.pp svneol=native#text/pascal
tests/test/tgenconstraint37.pp svneol=native#text/pascal
tests/test/tgenconstraint38.pp svneol=native#text/pascal
tests/test/tgenconstraint39.pp svneol=native#text/pascal
tests/test/tgenconstraint4.pp svneol=native#text/pascal
tests/test/tgenconstraint40.pp svneol=native#text/pascal
tests/test/tgenconstraint5.pp svneol=native#text/pascal
tests/test/tgenconstraint6.pp svneol=native#text/pascal
tests/test/tgenconstraint7.pp svneol=native#text/pascal
@ -14067,6 +14071,7 @@ tests/webtbs/tw2649.pp svneol=native#text/plain
tests/webtbs/tw2651.pp svneol=native#text/plain
tests/webtbs/tw2656.pp svneol=native#text/plain
tests/webtbs/tw2659.pp svneol=native#text/plain
tests/webtbs/tw26599.pp svneol=native#text/pascal
tests/webtbs/tw26615.pp svneol=native#text/pascal
tests/webtbs/tw26627.pp -text svneol=native#text/plain
tests/webtbs/tw2666.pp svneol=native#text/plain

View File

@ -182,11 +182,26 @@ uses
odt_interfacecorba,
odt_interfacejava,
odt_dispinterface:
if not def_is_related(paraobjdef,formalobjdef.childof) then
begin
MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
result:=false;
end;
begin
if (oo_is_forward in paraobjdef.objectoptions) and
(paraobjdef.objecttype=formalobjdef.objecttype) and
(df_genconstraint in formalobjdef.defoptions) and
(
(formalobjdef.objecttype=odt_interfacecom) and
(formalobjdef.childof=interface_iunknown)
)
or
(
(formalobjdef.objecttype=odt_interfacecorba) and
(formalobjdef.childof=nil)
) then
continue;
if not def_is_related(paraobjdef,formalobjdef.childof) then
begin
MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
result:=false;
end;
end;
odt_class,
odt_javaclass:
begin
@ -225,6 +240,14 @@ uses
result:=false;
continue;
end;
{ for forward declared classes we allow pure TObject/class declarations }
if (oo_is_forward in paraobjdef.objectoptions) and
(df_genconstraint in formaldef.defoptions) then
begin
if (formalobjdef.childof=class_tobject) and
not formalobjdef.implements_any_interfaces then
continue;
end;
if assigned(formalobjdef.childof) and
not def_is_related(paradef,formalobjdef.childof) then
begin

View File

@ -0,0 +1,35 @@
{ %NORUN }
program tgenconstraint37;
{$mode objfpc}
type
generic TGenericTObject<T: TObject> = class
end;
generic TGenericClass<T: class> = class
end;
generic TGenericIInterface<T: IInterface> = class
end;
TTestObject = class;
ITestInterface = interface;
TGenericTObjectTTestObject = specialize TGenericTObject<TTestObject>;
TGenericClassTTestObject = specialize TGenericClass<TTestObject>;
TGenericIInterfaceITestInterface = specialize TGenericIInterface<ITestInterface>;
TTestObject = class
end;
ITestInterface = interface
end;
begin
end.

View File

@ -0,0 +1,20 @@
{ %FAIL }
program tgenconstraint38;
{$mode objfpc}
type
generic TGeneric<T: TObject, IInterface> = class
end;
TTest = class;
TGenericTTest = specialize TGeneric<TTest>;
TTest = class
end;
begin
end.

View File

@ -0,0 +1,23 @@
{ %FAIL }
program tgenconstraint39;
{$mode objfpc}
type
TSomeClass = class
end;
generic TGeneric<T: TSomeClass> = class
end;
TTest = class;
TGenericTTest = specialize TGeneric<TTest>;
TTest = class(TSomeClass)
end;
begin
end.

View File

@ -0,0 +1,23 @@
{ %FAIL }
program tgenconstraint40;
{$mode objfpc}
type
ISomeInterface = interface
end;
generic TGeneric<T: ISomeInterface> = class
end;
ITest = interface;
TGenericITest = specialize TGeneric<ITest>;
ITest = interface(ISomeInterface)
end;
begin
end.

19
tests/webtbs/tw26599.pp Normal file
View File

@ -0,0 +1,19 @@
{ %NORUN }
program tw26599;
{$mode delphi}
type
TSomeList<T : TObject> = Class
End; { Class }
TSomeClass = Class;
TSomeClassList = TSomeList<TSomeClass>;
TSomeClass = Class(TObject)
SomeList : TSomeClassList;
End;
begin
end.