paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-14 11:49:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revisions 485 via svnmerge from

Browse Source 
/trunk

git-svn-id: branches/fixes_2_0@521 -
This commit is contained in:
peter 2005-06-29 09:34:45 +00:00
parent dd0d47daca
commit 645b6201c9
3 changed files with 106 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -5303,6 +5303,7 @@ tests/webtbf/tw3738.pp svneol=native#text/plain
tests/webtbf/tw3740.pp svneol=native#text/plain
tests/webtbf/tw3790.pp svneol=native#text/plain
tests/webtbf/tw3841.pp svneol=native#text/plain
tests/webtbf/tw4111.pp svneol=native#text/plain
tests/webtbf/uw0744.pp svneol=native#text/plain
tests/webtbf/uw0840a.pp svneol=native#text/plain
tests/webtbf/uw0840b.pp svneol=native#text/plain

91
compiler/htypechk.pas
View File

@ -840,6 +840,7 @@ implementation
gotstring,
gotwith,
gotsubscript,
gotrecord,
gotpointer,
gotvec,
gotclass,
@ -857,6 +858,7 @@ implementation
gotsubscript:=false;
gotvec:=false;
gotderef:=false;
gotrecord:=false;
gotclass:=false;
gotpointer:=false;
gotwith:=false;
@ -874,43 +876,60 @@ implementation
{ property allowed? calln has a property check itself }
if (nf_isproperty in hp.flags) then
begin
if (hp.nodetype<>calln) or
(valid_property in opts) then
result:=true
if (hp.nodetype=calln) then
begin
{ check return type }
case hp.resulttype.def.deftype of
pointerdef :
gotpointer:=true;
objectdef :
gotclass:=is_class_or_interface(hp.resulttype.def);
recorddef :
gotrecord:=true;
classrefdef :
gotclass:=true;
stringdef :
gotstring:=true;
end;
if (valid_property in opts) then
begin
{ don't allow writing to calls that will create
temps like calls that return a structure and we
are assigning to a member }
if (valid_const in opts) or
not(
(gotsubscript and gotrecord) or
(gotstring and gotvec)
) then
result:=true
else
CGMessagePos(hp.fileinfo,errmsg);
end
else
begin
{ 1. if it returns a pointer and we've found a deref,
2. if it returns a class or record and a subscription or with is found
3. if the address is needed of a field (subscriptn) }
if (gotpointer and gotderef) or
(gotstring and gotvec) or
(
(gotclass or gotrecord) and
(gotsubscript or gotwith)
) or
(
(gotvec and gotdynarray)
) or
(
(Valid_Addr in opts) and
(hp.nodetype=subscriptn)
) then
result:=true
else
CGMessagePos(hp.fileinfo,errmsg);
end;
end
else
begin
{ check return type }
case hp.resulttype.def.deftype of
pointerdef :
gotpointer:=true;
objectdef :
gotclass:=is_class_or_interface(hp.resulttype.def);
recorddef, { handle record like class it needs a subscription }
classrefdef :
gotclass:=true;
stringdef :
gotstring:=true;
end;
{ 1. if it returns a pointer and we've found a deref,
2. if it returns a class or record and a subscription or with is found
3. if the address is needed of a field (subscriptn) }
if (gotpointer and gotderef) or
(gotstring and gotvec) or
(
gotclass and
(gotsubscript or gotwith)
) or
(
(gotvec and gotdynarray)
) or
(
(Valid_Addr in opts) and
(hp.nodetype=subscriptn)
) then
result:=true
else
CGMessagePos(hp.fileinfo,errmsg);
end;
result:=true;
exit;
end;
if (Valid_Const in opts) and is_constnode(hp) then

50
tests/webtbf/tw4111.pp Executable file
View File

@ -0,0 +1,50 @@
{ %fail }
{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
type
TPoint = record
X,Y : integer;
end;
{ TSomeUselessObject }
TSomeUselessObject = class(TObject)
fSomeProperty: TPoint;
private
function GetSomeProperty: TPoint;
procedure SetSomeProperty(AValue: TPoint);
public
constructor Create;
property SomeProperty: TPoint read GetSomeProperty write SetSomeProperty;
end;
{ TSomeUselessObject }
procedure TSomeUselessObject.SetSomeProperty(AValue: TPoint);
begin
fSomeProperty := AValue;
end;
function TSomeUselessObject.GetSomeProperty: TPoint;
begin
Result := fSomeProperty;
end;
constructor TSomeUselessObject.Create;
begin
fSomeProperty.X := 50;
fSomeProperty.Y := 100;
end;
var SomeUselessObject: TSomeUselessObject;
begin
SomeUselessObject := TSomeUselessObject.Create;
WriteLn('By Default X = ', SomeUselessObject.SomeProperty.X, ' and Y = ',
SomeUselessObject.fSomeProperty.Y);
SomeUselessObject.SomeProperty.X := 200;
SomeUselessObject.SomeProperty.Y := 500;
WriteLn('Now X = ', SomeUselessObject.SomeProperty.X, ' and Y = ',
SomeUselessObject.fSomeProperty.Y);
end.