mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 15:28:00 +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/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
|
||||
|
@ -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
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