* patch by Aleksa Todorovic to handle access to types inside generics correctly

when they are used as class variables, resolves #18096

git-svn-id: trunk@16474 -
This commit is contained in:
florian 2010-11-29 09:37:09 +00:00
parent 0d57d38d7c
commit 7d1627e9ca
4 changed files with 74 additions and 4 deletions

2
.gitattributes vendored
View File

@ -9977,6 +9977,8 @@ tests/webtbf/tw1754.pp svneol=native#text/plain
tests/webtbf/tw1754b.pp svneol=native#text/plain
tests/webtbf/tw17646a.pp svneol=native#text/plain
tests/webtbf/tw1782.pp svneol=native#text/plain
tests/webtbf/tw18096.pp svneol=native#text/pascal
tests/webtbf/tw18096c.pp svneol=native#text/pascal
tests/webtbf/tw1827.pp svneol=native#text/plain
tests/webtbf/tw1830.pp svneol=native#text/plain
tests/webtbf/tw1842.pp svneol=native#text/plain

View File

@ -149,6 +149,8 @@ implementation
function tloadvmtaddrnode.pass_typecheck:tnode;
var
defaultresultdef : boolean;
begin
result:=nil;
typecheckpass(left);
@ -160,13 +162,24 @@ implementation
resultdef:=left.resultdef;
objectdef :
{ access to the classtype while specializing? }
if (df_generic in left.resultdef.defoptions) and
assigned(current_objectdef.genericdef) then
if (df_generic in left.resultdef.defoptions) then
begin
if current_objectdef.genericdef=left.resultdef then
resultdef:=tclassrefdef.create(current_objectdef)
defaultresultdef:=true;
if assigned(current_objectdef) then
begin
if assigned(current_objectdef.genericdef) then
if current_objectdef.genericdef=left.resultdef then
begin
resultdef:=tclassrefdef.create(current_objectdef);
defaultresultdef:=false;
end
else
message(parser_e_cant_create_generics_of_this_type);
end
else
message(parser_e_cant_create_generics_of_this_type);
if defaultresultdef then
resultdef:=tclassrefdef.create(left.resultdef);
end
else
resultdef:=tclassrefdef.create(left.resultdef);

24
tests/webtbf/tw18096.pp Normal file
View File

@ -0,0 +1,24 @@
{ %fail }
{$mode objfpc}
type
generic tc1<T> = class
public
x : T;
end;
generic tc2<T> = class
type tc2a = specialize tc1<T>;
var x : tc2a;
end;
tc2_Integer = specialize tc2<Integer>;
var
a : tc2_Integer;
begin
a := tc2_Integer.Create;
a.x := tc2.tc2a.Create; // this is not allowed, user must use specialization of tc2
a.x.x := 99;
if (a.x.x <> 99) then
Halt(1);
end.

31
tests/webtbf/tw18096c.pp Normal file
View File

@ -0,0 +1,31 @@
{ %fail }
{$mode objfpc}
type
generic G<_T> = class
end;
generic TGen<_T> = class
public
function Check(ASource: TObject): Boolean;
end;
TSpec = specialize TGen<Integer>;
function TGen.Check(ASource: TObject): Boolean;
begin
Result := not (ASource is G) // we are testing this: usage of another generic is not allowed
and (ASource is TGen) // this should work...
and (ASource is ClassType); // ...and it should be equivelent to this line
end;
var
f: TSpec;
o: TObject;
begin
f := TSpec.Create;
o := TObject.Create;
if not(f.Check(f)) or f.Check(o) then
halt(1);
writeln('ok');
end.