mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-24 23:29:15 +02:00
* 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:
parent
0d57d38d7c
commit
7d1627e9ca
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -9977,6 +9977,8 @@ tests/webtbf/tw1754.pp svneol=native#text/plain
|
|||||||
tests/webtbf/tw1754b.pp svneol=native#text/plain
|
tests/webtbf/tw1754b.pp svneol=native#text/plain
|
||||||
tests/webtbf/tw17646a.pp svneol=native#text/plain
|
tests/webtbf/tw17646a.pp svneol=native#text/plain
|
||||||
tests/webtbf/tw1782.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/tw1827.pp svneol=native#text/plain
|
||||||
tests/webtbf/tw1830.pp svneol=native#text/plain
|
tests/webtbf/tw1830.pp svneol=native#text/plain
|
||||||
tests/webtbf/tw1842.pp svneol=native#text/plain
|
tests/webtbf/tw1842.pp svneol=native#text/plain
|
||||||
|
@ -149,6 +149,8 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function tloadvmtaddrnode.pass_typecheck:tnode;
|
function tloadvmtaddrnode.pass_typecheck:tnode;
|
||||||
|
var
|
||||||
|
defaultresultdef : boolean;
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
typecheckpass(left);
|
typecheckpass(left);
|
||||||
@ -160,13 +162,24 @@ implementation
|
|||||||
resultdef:=left.resultdef;
|
resultdef:=left.resultdef;
|
||||||
objectdef :
|
objectdef :
|
||||||
{ access to the classtype while specializing? }
|
{ access to the classtype while specializing? }
|
||||||
if (df_generic in left.resultdef.defoptions) and
|
if (df_generic in left.resultdef.defoptions) then
|
||||||
assigned(current_objectdef.genericdef) then
|
|
||||||
begin
|
begin
|
||||||
if current_objectdef.genericdef=left.resultdef then
|
defaultresultdef:=true;
|
||||||
resultdef:=tclassrefdef.create(current_objectdef)
|
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
|
else
|
||||||
message(parser_e_cant_create_generics_of_this_type);
|
message(parser_e_cant_create_generics_of_this_type);
|
||||||
|
if defaultresultdef then
|
||||||
|
resultdef:=tclassrefdef.create(left.resultdef);
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
resultdef:=tclassrefdef.create(left.resultdef);
|
resultdef:=tclassrefdef.create(left.resultdef);
|
||||||
|
24
tests/webtbf/tw18096.pp
Normal file
24
tests/webtbf/tw18096.pp
Normal 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
31
tests/webtbf/tw18096c.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user