mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 05:08:06 +02:00
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:
parent
f8c7290dbb
commit
684c8842e7
5
.gitattributes
vendored
5
.gitattributes
vendored
@ -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
|
||||
|
@ -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
|
||||
|
35
tests/test/tgenconstraint37.pp
Normal file
35
tests/test/tgenconstraint37.pp
Normal 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.
|
20
tests/test/tgenconstraint38.pp
Normal file
20
tests/test/tgenconstraint38.pp
Normal 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.
|
23
tests/test/tgenconstraint39.pp
Normal file
23
tests/test/tgenconstraint39.pp
Normal 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.
|
23
tests/test/tgenconstraint40.pp
Normal file
23
tests/test/tgenconstraint40.pp
Normal 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
19
tests/webtbs/tw26599.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user